Copy and paste data from multiple worksheets in a master sheet

[Krissnyc]

Hello everyone,

I just joined the forum, and this is my first post. I am totally naïve to running macros and need your help to automate the consolidation of multiple worksheets. I have around ten worksheets - columns A to M are fixed in all the spreadsheet and rows keep changing as and when the data is inputted. The first seven rows include the title and other information. I have created a master sheet at the beginning with titles already copied and would like to get the data from all worksheets starting from row 7 and columns A to M.

I tried quite a few codes, including setting current region, etc., but the result looks awful as it also copies titles and creates extra spaces in between. I just want to see the data continuously flowing without titles and automatically include new rows. I would greatly appreciate your input. Thank you!

 

[jbeaucaire]

'WORKBOOKS TO 1 SHEET STACKED
Here's a macro for collecting data from all files in a specific folder.

Workbooks to 1 Sheet​

The parts of the code that need to be edited are colored red to draw your attention.

1) Most important, set the wsMaster to the correct sheetname in your master workbook (line 18)
2) Set the copy command to start at A7 (line 43)

...but review all the parts in red and make sure they make sense to your project.

 

[jolivanes]

Is it Workbooks (jbeaucaire's code) or Worksheets in one Workbook (this code)?

Sub Maybe()
    Dim Master As String, sh As Worksheet, lr As Long, lr1 As Long
    Master = ActiveSheet.Name    '<------ This is your master sheet
    lr1 = 1
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> Master Then
            With sh
                lr = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                .Range("A8:M" & lr).Copy Sheets(Master).Range("A" & lr1) 
            End With
        End If
        lr1 = lr1 + lr
    Next sh
    Application.ScreenUpdating = True
End Sub

 

[Krissnyc]

Thank you Jolivanes for your help. There are multiple worksheets within a workbook. I need the data from all worksheets starting from a specific row, copied into the master sheet and refresh automatically with new data/row. Hope this clarifies.

Is it Workbooks (jbeaucaire's code) or Worksheets in one Workbook (this code)?

Sub Maybe()
    Dim Master As String, sh As Worksheet, lr As Long, lr1 As Long
    Master = ActiveSheet.Name    '<------ This is your master sheet
    lr1 = 1
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> Master Then
            With sh
                lr = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                .Range("A8:M" & lr).Copy Sheets(Master).Range("A" & lr1) 
            End With
        End If
        lr1 = lr1 + lr
    Next sh
    Application.ScreenUpdating = True
End Sub

 

[jbeaucaire]

'MANY SHEETS TO ONE SHEET
Here's another macro for merging data from multiple sheets in a single workbook into a "consolidation" sheet in the same workbook where the source sheets are the same layout.

Sheets to One Sheet - Part 1​

There's a sample file there, too, to make it easy to try it out. Again, the parts in red are the parts most likely needing your attention/tweaks.

 

[Krissnyc]

I just tried this code but there are couple of issues:
1. In the master sheet, 5 to 6 blank rows are created in between every worksheet data
2. Some data entered on the rows are not copied regardless of starting cell filled some value

Can you please modify the code?

Is it Workbooks (jbeaucaire's code) or Worksheets in one Workbook (this code)?

Sub Maybe()
    Dim Master As String, sh As Worksheet, lr As Long, lr1 As Long
    Master = ActiveSheet.Name    '<------ This is your master sheet
    lr1 = 1
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> Master Then
            With sh
                lr = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                .Range("A8:M" & lr).Copy Sheets(Master).Range("A" & lr1) 
            End With
        End If
        lr1 = lr1 + lr
    Next sh
    Application.ScreenUpdating = True
End Sub

 

[jolivanes]

Are the column lengths all the same in these sheets?
Which column can we use to find the last used cell? Column A?
You must have data past Column M because the code looks for the last used cell in the whole sheet

 

[jolivanes]

Try this, on a copy of your workbook, and let us know.
Good luck.

Sub Maybe()
    Dim Master As String, sh As Worksheet
    Master = ActiveSheet.Name    '<------ This is your master sheet
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> Master Then
            With sh
                .Range("A8:M" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy Sheets(Master).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            End With
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

 

[jolivanes]

My bad. Should have tested the code in Post #3 before posting.
In case your Column lengths for Columns A to M are not the same, this should work.
Otherwise the code from Post #8 should be OK. You can use this code also.

Sub Maybe_Different_Length()
    Dim Master As String, sh As Worksheet, lr As Long, lr1 As Long
    Master = ActiveSheet.Name    '<------ This is your master sheet
    lr1 = 8
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> Master Then
            With sh
                lr = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                .Range("A8:M" & lr).Copy Sheets(Master).Range("A" & lr1)
            End With
        lr1 = lr1 + lr - 7
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub

 

[Krissnyc]

This worked perfectly. Thank you so much! I wish I could learn this. Any tips to get strong hold of VBA?

My bad. Should have tested the code in Post #3 before posting.
In case your Column lengths for Columns A to M are not the same, this should work.
Otherwise the code from Post #8 should be OK. You can use this code also.

Sub Maybe_Different_Length()
    Dim Master As String, sh As Worksheet, lr As Long, lr1 As Long
    Master = ActiveSheet.Name    '<------ This is your master sheet
    lr1 = 8
    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> Master Then
            With sh
                lr = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                .Range("A8:M" & lr).Copy Sheets(Master).Range("A" & lr1)
            End With
        lr1 = lr1 + lr - 7
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub