I am looking to combine multiple sheets into a single consolidated sheet

问题

Would like to create a Macro to loop through all of the sheets in the workbook and select all the data from each worksheet and then paste said data into a single consolidate table on the "Master" sheet. All sheets have the same column heading to Column "AB".

Currently tried using this code but I have been unable to get anything to paste over onto the Master worksheet. Might be overthinking setting the range each tab.

Just looking for a simple solution to copy all active data from each sheet and paste it into one sheet so that is its all consolidated.

Thanks in advance!

Sub CombineData()
Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim WB As Workbook
Dim rngDst As Range
Dim rngSrc As Range
Dim DstLastRow As Long
Dim SrcLastRow As Long

'Refrences
Set wkstDst = ActiveWorkbook.Worksheets("Master")


'Setting Destination Range
Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)

'Loop through all sheets exclude Master
For Each wkstSrc In ThisWorkbook.Worksheets
   If wkstSrc.Name <> "Master" Then

        SrcLastRow = LastOccupiedRowNum(wkstSrc)
        With wkstSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLastRow, 28))
            rngSrc.Copy Destination:=rngDst
        End With

        DstLastRow = LastOccupiedRowNum(wkstDst)
        Set rngDst = wkstDst.Cells(DstLastRow + 1, 1)

    End If

 Next wkstSrc


End Sub

回答1:

Throwing another method into the mix. This does assume that the data you are copying has as many rows in column A as it does in any other column. It doesn't require your function.

Sub CombineData()

Dim wkstDst As Worksheet
Dim wkstSrc As Worksheet
Dim rngSrc As Range

Set wkstDst = ThisWorkbook.Worksheets("Master")

For Each wkstSrc In ThisWorkbook.Worksheets
   If wkstSrc.Name <> "Master" Then
        With wkstSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 28)
            rngSrc.Copy Destination:=wkstDst.Cells(Rows.Count, 1).End(xlUp)(2)
        End With
    End If
Next wkstSrc

End Sub

回答2:

You have copied this from somewhere else and you have forgotten to copy the function that gets the last row of a worksheet, namely this one LastOccupiedRowNum

So add this function to the same module and the code should work. Please don't forget to mark this as the right answer if it did work:

Function LastOccupiedRowNum(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
    'Finds the last row in a particular column which has a value in it
    If sh Is Nothing Then
        Set sh = ActiveSheet
    End If
    LastOccupiedRowNum= sh.Cells(sh.Rows.Count, colNumber).End(xlUp).row
End Function

回答3:

Try finding the last row dynamically, rather than using .cells

Dim lrSrc as Long, lrDst as Long, i as Long
For i = 1 to Sheets.Count
    If Not Sheets(i).Name = "Destination" Then
        lrSrc = Sheets(i).Cells( Sheets(i).Rows.Count,"A").End(xlUp).Row
        lrDst = Sheets("Destination").Cells( Sheets("Destination").Rows.Count, "A").End(xlUp).Row
        With Sheets(i)
            .Range(.Cells(2,"A"), .Cells(lrSrc,"AB")).Copy Sheets("Destination").Range(Sheets("Destination").Cells(lrDst+1,"A"),Sheets("Destination").Cells(lrDst+1+lrSrc,"AB"))
        End With
    End If
 Next i

This should replace your sub and the related function.

来源：https://stackoverflow.com/questions/49638371/i-am-looking-to-combine-multiple-sheets-into-a-single-consolidated-sheet