Unable to combine multiple (autofltered) sheets into a single worksheet

[ezphua89]

Hi,

I am not a vba expert and have been looking for vba codes online to help with merging multiple sheets into a single sheet.

Basically, I have multiple sheets that I have already filtered out for blanks in Column B. I would like to transfer that data of each spreadsheet (Column A-G, from rows 8 to last row) into a master sheet called "Combined". After pasting the data on to the master sheet, I would like the rows copied to be labelled with the sheet name they came from to be in Column I.

So far, the code that I am using does not go through each sheet and is unable to select the filtered data from each spreadsheet.

Code used below:


Sub CopyData()
Dim Sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long


With Application
.ScreenUpdating = False
.EnableEvents = False

End With
' Set destination worksheet.
Set DestSh = Sheets("Combined")
DestSh.Name = "Combined"
' Fill in the start row.
StartRow = 5
' Loop through all worksheets and copy the data to the
' summary worksheet.
' Except for Info sheet and Summary II.

For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Name, _
Array(DestSh.Name, "Info Sheet", "Summary II"), 0)) Then

Sh.Select
LastRow = Range("B2000").End(xlUp).Row
Last = Range("B2000").End(xlUp).Row
Set CopyRng = Range("A8", Cells(LastRow, "H"))
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

' This statement will copy the sheet
' name in the I column.
DestSh.Cells(Last + 1, "I").Resize(CopyRng.Rows.Count).Value = Sh.Name
Else
End If
Next Sh
ExitTheSub:
Application.Goto DestSh.Cells(1)

DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub


Would appreciate any help given! Thank you much!

 

[Andrew Poulsom]

I think this:

Last = Range("B2000").End(xlUp).Row

should be:

Last = DestSh.Range("B2000").End(xlUp).Row

 

[ezphua89]

I think this:

Last = Range("B2000").End(xlUp).Row

should be:

Last = DestSh.Range("B2000").End(xlUp).Row

Thanks so much Andrew! It Works now!