Excel Macro to combine worksheets

[pbajeff29]

I am looking for a macro that will step through each sheet and add all rows with data to the first sheet. It will need to look from row 2 down and then paste to the first empty row at the bottom of the list in page 1.

Example:
Sheet 1 - Results
Sheet 2 - AM
Sheet 3 - PM

Columns (A-P) match in all three row. And each sheet will be variable number of rows and changing daily.

 

[Logit]

Sub master_sheet()

    Dim wsM As Worksheet
    Set wsM = Sheets("Sheet1")
    
    'assumes Master sheet is the first sheet
    For x = 2 To Worksheets.Count
        Sheets(x).UsedRange.Copy Destination:=wsM.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        
    Next x
  
End Sub

 

[pbajeff29]

Sub master_sheet()

    Dim wsM As Worksheet
    Set wsM = Sheets("Sheet1")
   
    'assumes Master sheet is the first sheet
    For x = 2 To Worksheets.Count
        Sheets(x).UsedRange.Copy Destination:=wsM.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
       
    Next x
 
End Sub

It did not like the := so I removed the : and it accepted. Once I tried to run the Macro it gives me a run-time error '424': Object Required

 

[Logit]

As is, the macro requires your sheet names shall be Sheet1, Sheet2, Sheet3, etc.

If your sheets are names something else, you'll need to adjust the macro to match.

 

[pbajeff29]

Ok I got it to run, but instead of it grabbing the information and putting it into the columns that exist on Sheet1, it is copying the entire list including the headers and adding it to the end of the column headers. It did that for each sheet, so it is not putting them down, it is doing them side to side. So after two sheets, I had 54 columns (first 18 with the headers, second 18 are headers and data from Sheet2 and 3rd 18 are headers and data from Sheet3. I need it to not copy the headers and to place them under the existing headers in Sheet1 and continue adding them straight down.

 

[Logit]

My bad .... the first suggested macro does precisely what you are experiencing ... copying to new columns to the right.

I believe this is what you are seeking :

Option Explicit

Sub Maybe()
    Dim sh As Worksheet
    
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> "Sheet1" Then sh.UsedRange.Offset(1).Copy Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next sh
    
End Sub

 

[alansidman]

Since you are using O365, you have the option of using Power Query to do this. Look at this video tutorial as an alternative to VBA

 

[pbajeff29]

Since you are using O365, you have the option of using Power Query to do this. Look at this video tutorial as an alternative to VBA

Love this thank you, it got me almost to where I need to be. I got the master list and I created a pivot off of it, which is something I need. But when I refresh all, I then have to do a separate refresh directly on the pivot. I am creating a button so that when users need to update, they click it and it pulls the data from SharePoint into the respective sheets and the Append sheet updates as well. But I also need it to update the Pivot. I did the following code for the refresh button and it works for everything but the pivot, any thoughts?

Sub Refresh()

ThisWorkbook.RefreshAll

Pivot.PivotTables("PivotTable1").PivotCache.Refresh

End Sub

 

[alansidman]

Try this

ActiveWorkbook.RefreshAll

 

[pbajeff29]

Try this

ActiveWorkbook.RefreshAll

Nope, not working. For some reason it is not accepting anything I throw at it to update the pivot. It is refreshing the SharePoint queries in the individual sheets and doing the Append function, but it will not update the pivot automatically.