I have a Workbook with multiple sheets, all with the same configuration, with headers on row 1 and data starting from row 2.
I want to combine the data from all the sheets into one single sheet called “Target”. I have to go through all the sheets and check what is the last row and the last column with data to define the range that I’m going to copy to the Target sheet. I think that the code is all well commented for you to understand how this is done. This is a simple example how to combine data from multiple sheets into one single sheet. This can be done other ways or can be more complex with sheets with different columns or so. This will be handled in future articles.
Sub CombineSheets()
'This macro will copy all rows from the first sheet
'(including headers)
'and on the next sheets will copy only the data
'(starting on row 2)
Dim i As Integer
Dim j As Long
Dim SheetCnt As Integer
Dim lstRow1 As Long
Dim lstRow2 As Long
Dim lstCol As Integer
Dim ws1 As Worksheet
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
'Delete the Target Sheet on the document (in case it exists)
Sheets("Target").Delete
'Count the number of sheets on the Workbook
SheetCnt = Worksheets.Count
'Add the Target Sheet
Sheets.Add after:=Worksheets(SheetCnt)
ActiveSheet.Name = "Target"
Set ws1 = Sheets("Target")
lstRow2 = 1
'Define the row where to start copying
'(first sheet will be row 1 to include headers)
j = 1
'Combine the sheets
For i = 1 To SheetCnt
Worksheets(i).Select
'check what is the last column with data
lstCol = ActiveSheet.Cells(1, Activesheet.Columns.Count).End(xlToLeft).Column
'check what is the last row with data
lstRow1 = ActiveSheet.Cells(activesheet.rows.count, "A").End(xlUp).Row
'Define the range to copy
Range("A" & j, Cells(lstRow1, lstCol)).Select
'Copy the data
Selection.Copy
ws1.Range("A" & lstRow2).PasteSpecial
Application.CutCopyMode = False
'Define the new last row on the Target sheet
lstRow2 = ws1.Cells(65536, "A").End(xlUp).Row + 1
'Define the row where to start copying
'(2nd sheet onwards will be row 2 to only get data)
j = 2
Next
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Sheets("Target").Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
