Macros to Consolidate Worksheets

I’ve got a spreadsheet with tabs for each individual directorate. Within the tabs are tables with the same layout but different sizes (number of rows).

I want to group together all the used data on each tab and create a single consolidated sheet of continuous data.

Obviously I need a macro to copy and paste my data from each sheet but the tricky bit is selecting the relevant (or used) area in each sheet.

On my search around the interweb I found some really useful snippets of VBA code on the Ozgrid website which enable you to determine the last used row according to a number of different criteria and assign this to a variable such as “iLastRow”.

1
2
'find row before next blank cell in column A
iLastRow = Range("A1").End(xlDown).Row
1
2
'find last used row in column A
iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
1
2
'find last used row on sheet
iLastRow = Cells.Find(what:="*", SearchOrder:=xlByRows, _SearchDirection:=xlPrevious).Row

It’s a simple step then to use this variable to define a range of used cells.

1
Range("A1:P" & iLastRow).Select

I’ve used the above techniques to consolidate my worksheets and here’s a copy of my working code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub ConsolidateSheetsforSubForm()
' ConsolidateSheetsforSubForm Macro
' Copies used subform data in individual sheets and pastes into one sheet as continuous data

Sheets("Ap Table Sub Form").Select

'find last used row column a of Ap Table Sub Form sheet
ilastrowsubf = Cells(Rows.Count, "a").End(xlUp).Row

' Clear the existing data in the subform sheet
'specify location in subform to clear data
Range("a5:k" & ilastrowsubf).ClearContents

' Start selecting the data from Sheet S&M (LY)
Sheets("S&M (LY)").Select

' find last used row in column I
ilastrowsm = Cells(Rows.Count, "i").End(xlUp).Row

' use ilastrowsm variable to define range to copy in S&M sheet
Range("i4:s" & ilastrowsm).Copy

' specify location in subform to paste data
Sheets("Ap Table Sub Form").Select
Range("a5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("K&R (BV)").Select

' find last used row in column I of K&R sheet
ilastrowkr = Cells(Rows.Count, "i").End(xlUp).Row

' use ilastrowkr variable to define range to copy in K&R sheet
Range("i4:s" & ilastrowkr).Copy
Sheets("Ap Table Sub Form").Select

' find first blank row in column a of Ap Table Sub Form sheet
ifirstblankrowsubf = (Cells(Rows.Count, "a").End(xlUp).Row) + 1

' specify location in subform to paste data
Range("a" & ifirstblankrowsubf).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("OVERHEADS").Select

' find last used row in column I of OVERHEADS sheet
ilastrowover = Cells(Rows.Count, "i").End(xlUp).Row

' use ilastrowover variable to define range to copy in OVERHEADS sheet
Range("i4:s" & ilastrowover).Copy
Sheets("Ap Table Sub Form").Select

' find first blank row in column a of Ap Table Sub Form sheet
ifirstblankrowsubf = (Cells(Rows.Count, "a").End(xlUp).Row) + 1

' specify location in subform to paste data
Range("a" & ifirstblankrowsubf).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A5").Select
End Sub

You can do similar things in order to find the last column as well:

1
2
3
4
5
6
7
8
9
'find column before next blank cell in row 1
iLastColumn = Range("A1").End(xlToRight).Column

'find last used column in row 1
iLastColumn = Cells(Columns.Count, "a").End(xlToLeft).Column

'find last used column on sheet
iLastColumn = Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

You may also like