How to copy last row of data in all worksheets and paste it into one worksheet-CodePudding

Currently I have a lot of sheets in my Excel file but I want to get the last row of data in sheets that start with "6" as their names as the other sheets are not relevant. In the sheets that start with 6 are all in the same format but have different number of rows, I am interested in extracting the last row in all those sheets (columns D:J) and placing it into a "master sheet". Since I am quite new to VBA, how would I go about doing that? Thanks in advance!

What I have currently that can copy one sheet and paste into my master sheet "Sheet2":

   With Sheets("6363")
        With Range(.Cells(.Rows.Count, "D").End(xlUp), _
                   .Cells(.Cells(.Rows.Count, "D").End(xlUp).row, .Columns.Count).End(xlToLeft))
            Worksheets("Sheet2").Range("D1").Resize(, .Columns.Count).Value = .Value
        End With
    End With

CodePudding user response：

This will copy the last row, columns D-J, from every sheet with a name that starts with '6'.

It will put the copied data into the next empty row, starting at column D, of 'Sheet2'.

Sub CopySix()
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim rngSrc As Range
Dim rngDst As Range

    Set wsDst = ActiveWorkbook.Sheets("Sheet2")
    
    Set rngDst = wsDst.Range("D" & Rows.Count).End(xlUp).Offset(1)
    
    For Each wsSrc In ActiveWorkbook.Sheets
        If Left(wsSrc.Name, 1) = "6" Then
            Set rngSrc = wsSrc.Range("D" & Rows.Count).End(xlUp).Resize(, 7)
            rngDst.Resize(, 7).Value = rngSrc.Value
            Set rngDst = rngDst.Offset(1)
        End If
    Next wsSrc
    
End Sub