2

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
Community
  • 1
  • 1
BlankB
  • 33
  • 3
  • 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 Apr 03 '18 at 20:13
  • You haven't assigned a value to `DstLastRow` – chris neilsen Apr 03 '18 at 20:24
  • @chrisneilsen- uninitialised it will be zero so doesn't matter. – SJR Apr 03 '18 at 20:29
  • This seems to be a duplicate question, [SO Question](https://stackoverflow.com/questions/18854432/copy-all-worksheets-into-one-sheet?rq=1) – GMalc Apr 04 '18 at 02:32

3 Answers3

2

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
SJR
  • 22,986
  • 6
  • 18
  • 26
  • Spoke to soon. It seems I have some blanks that are not being copied over. I noticed if I place some characters in the cell it works fine. – BlankB Apr 03 '18 at 21:18
  • What exactly do you mean "some blanks"? Where? – SJR Apr 03 '18 at 21:23
  • There is a notes section in Column A for each sheet the first sheet the notes have not been entered yet thus leave around 84 rows blank. If I type something into that row and run the script it pulls it over if I dont it seems to leave it out. – BlankB Apr 03 '18 at 21:26
  • If you have 20 rows of data in column A then 20 rows will be copied across to the master sheet, even if you have blank rows in the middle. Are you saying that you have rows with no data in column A but data in other columns? If so, this relates to the comment I made above. – SJR Apr 03 '18 at 21:31
  • Ah I see - I might just end up rearranging the columns then so that Column A is my main identifier. Thank you – BlankB Apr 03 '18 at 21:34
  • You could do that or the code could be amended if you like? – SJR Apr 03 '18 at 21:40
  • I think it will be okay to just rearrange the columns so that column A contains consistent data. – BlankB Apr 04 '18 at 13:18
0

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
Ibo
  • 4,081
  • 6
  • 45
  • 65
  • Adding in the LastOccupiedRowNum lines did not work when tested. Thus I subbed that out for a set number of 28 as each sheet had data up till Column AB. – BlankB Apr 03 '18 at 20:50
  • Your problem was getting the last row and this function gives you the last row, of course, you can include this in the main sub but it is not recommended. I am sure I could get this work, but since others answered and you are happy then I would not work more on it – Ibo Apr 03 '18 at 21:13
  • I think I was treating the previous script in an universal fashion which ended up to working the way I thought it would. Thanks for taking a look at this! – BlankB Apr 03 '18 at 21:22
0

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.

Cyril
  • 6,448
  • 1
  • 18
  • 31