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

2
votes

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
3
excelvba
Step through your code and check the values returned by your function. You might want to post the code for that too. Do the cells you are pasting contain formulae? – SJR
You haven't assigned a value to DstLastRow – chris neilsen
@chrisneilsen- uninitialised it will be zero so doesn't matter. – SJR
This seems to be a duplicate question, SO Question – GMalc

3 Answers

2
votes

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
0
votes

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
0
votes

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.