Consolidate sheets

[Watersource]

Hello all,

I am trying to consolidate a number of named sheets (005, 007 and 030) into a report sheet. All sheets have the same columns, only number of rows is different. I have managed to pull it off for one sheet, but all my tries to get it working for multiple sheets have failed. Row 9 is a header row, all data can be found starting row 10. Hope you can give me some tips on this.

Sub CreateReport()

Dim lastrow As Long
Dim MySht, Mysheets
Mysheets = ("005", "007", "030")


Sheets("Report").Select
Range("A10").Select
Sheets("005").Select
Range("A10").Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Rows("10:" & lastrow).Select
Selection.Copy
Sheets("Report").Select
Range("A10").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(1).Select


End Sub

Thanks,
René

 

[sandy666]

Use Power Query (Get&Transform) with Append feature

 

[Fluff]

How about

Sub Watersource()
   Dim Ws As Worksheet
   Dim NxtRw As Long
   
   With Sheets("Report")
      NxtRw = 10
      For Each Ws In Sheets(Array("005", "007", "030"))
         Ws.Range("A10", Ws.Range("A" & Rows.count).End(xlUp)).EntireRow.Copy .Range("A" & NxtRw)
         NxtRw = .Range("A" & Rows.count).End(xlUp).Offset(1).Row
      Next rw
   End With
End Sub

 

[Watersource]

Sub Watersource() Dim Ws As Worksheet Dim NxtRw As Long With Sheets("Report") NxtRw = 10 For Each Ws In Sheets(Array("005", "007", "030")) Ws.Range("A10", Ws.Range("A" & Rows.count).End(xlUp)).EntireRow.Copy .Range("A" & NxtRw) NxtRw = .Range("A" & Rows.count).End(xlUp).Offset(1).Row Next rw End With End Sub

Hello Fluff,

This indeed does the trick. I knew it had to be something like this but was not able to find the right syntax. There was just a (very) small typing error, instead Next Rw it is Next Ws.

Thanks so much for your help.

With kind regards,
René

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Watersource]

You're welcome & thanks for the feedback.

Hello Fluff,

It shows I was a bit to quick . When the sheets contain data, all goes well, but when e.g. sheet 005 only contains the header row(row 9), this line 9 is copied to the consolidated sheet. Would you have a trick to prevent this?

Thanks for your help on this.

With kind regards,
René

 

[Fluff]

How about

Sub Watersource()
   Dim ws As Worksheet
   Dim NxtRw As Long, UsdRws As Long
   
   With Sheets("Report")
      NxtRw = 10
      For Each ws In Sheets(Array("005", "007", "030"))
         UsdRws = ws.Range("A" & Rows.count).End(xlUp).Row
         If UsdRws > 9 Then
            ws.Range("A10:A" & UsdRws).EntireRow.Copy .Range("A" & NxtRw)
            NxtRw = .Range("A" & Rows.count).End(xlUp).Offset(1).Row
         End If
      Next rw
   End With
End Sub

 

[Watersource]

How about

Sub Watersource()
   Dim ws As Worksheet
   Dim NxtRw As Long, UsdRws As Long
  
   With Sheets("Report")
      NxtRw = 10
      For Each ws In Sheets(Array("005", "007", "030"))
         UsdRws = ws.Range("A" & Rows.count).End(xlUp).Row
         If UsdRws > 9 Then
            ws.Range("A10:A" & UsdRws).EntireRow.Copy .Range("A" & NxtRw)
            NxtRw = .Range("A" & Rows.count).End(xlUp).Offset(1).Row
         End If
      Next rw
   End With
End Sub

Hi Fluff,

This indeed works . Do I understand the code correctly that when UsdRws is larger then 9 this means there is something in line 10 and only then the lines are copied, and if this is not the case it goes to the next sheet?

Thanks for your help.

with kind regards,
René

 

[Fluff]

You understand correctly