Using VBA to copy data from multiple worksheets into single worksheet

[koe_ak]

I have a workbook that has approximately 330 worksheets in it with data on each worksheet and I need to consolidate it all onto a single summary sheet so that each sheet's data is appended in the summary sheet after the previous sheets data...in other words a list that continually appends all data onto one sheet. I know there is a macro that can do this, I just can't quite figure it out since I'm still learning VBA. I've looked on the web and in this forum, but still not able to get it.

Facts: # of columns to be consistent on each worksheet, # of rows will vary. Headers on each page start at row 15 and data in columns runs from A:AF (each sheet has the same headers). I only need the headers copied the first time and then the subsequent sheets will be all data below the headers. Again, # of rows on each sheet will vary and all start at row 15 (or 16 without headers).

I actually have numerous workbooks with approx 200-300 sheets each that I'll need to apply the code in and have a summary sheet in each (all have same format). Not looking to consolidate all the workbooks. Just need a summary sheet for each workbook. Obviously too many worksheets in each to copy and paste manually.

 

[JLGWhiz]

Sub merge()
Dim sh As Worksheet, lr As Long
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Summary"
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Summary" Then
            lr = sh.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
            If Application.CountA(Sheets("Summary").Range("A1:A15").EntireRow) = 0 Then
                sh.Range("A15:AF15").Copy Sheets("Summary").Range("A1")
            End If
            sh.Range("A16:AF" & lr).Copy Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
End Sub

 

[koe_ak]

Thank you so much for the quick response. The macro is creating a summary sheet, but it appears to be pulling in data that is outside the range (I think). I am also getting a #value in column A, Quote not selected in other columns and Need info in others. Is it possible to paste values on the summary tab and include a column with the tab name so I can see where the data is coming from? There were other macros in the workbook, but I moved only the worksheets I needed to another workbook and saved it as an .xlsm. I also deleted the remaining macros since I won't need them. I looked for hidden sheets also and do not see any.

I do see some data below the dataset I need, so can the row numbers be determined by finding the blank cell in column A (after A15 of course).

Also, eventually I get the error: Run-time error 91 Object variable or with block variable not set. Thanks again!

 

[JLGWhiz]

I can help you with the copy range, but the #Value errors are resulting from the worksheet content, and that I cannot help you with other than to use PasteSpecial for values only. The sheet name will appear in column AG. Delete the original code and use this one.

Sub merge2()
Dim sh As Worksheet,  r As Long
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Summary"
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Summary" Then
                       If Application.CountA(Sheets("Summary").Range("A1:A15").EntireRow) = 0 Then
                sh.Range("A15:AF15").Copy Sheets("Summary").Range("A1")
            End If
            sh.Range("A16", sh.Range("AF16").End(xlDown)).Copy
            r = sh.Range("A16", sh.Range("AF16").End(xlDown)).Rows.Count
            Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2).Offset(0, 32).Resize(r, 1) = "Sheet " & sh.Name
            Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
        End If
    Next
End Sub

 

[koe_ak]

Thanks again. I'm getting an error on this line (according to debug feature):

Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2).Offset(0, 32).Resize(r, 1) = "Sheet " & sh.Name
Error is Run-time error 1004: Application-defined or object-defined error

I see you put in the code to paste values and yes, that is what I was wanting.

 

[JLGWhiz]

I cannot duplicate the error in my test set up. I use a workbook with three sheets with headers on row 15, data on rows 16 +. It copies everything from 16 down and puts the sheet name in column AG, without error. Check you code closely to make sure no stray characters appear on that line. Also, see it the error occurred on the first sheet copies or if some copied OK before the error. If you have a really large file, it might be a limit on many it will fill down, although I haven't seen that before. I tested with several hundred rows and no problem.

If you can't find anything causing the error, just comment that line out so you can use the code. You can pretty much track they sheets because it copies them in the same order that they appear in the workbook.

 

[Neavalmi]

I can help you with the copy range, but the #Value errors are resulting from the worksheet content, and that I cannot help you with other than to use PasteSpecial for values only. The sheet name will appear in column AG. Delete the original code and use this one.

Sub merge2()
Dim sh As Worksheet,  r As Long
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Summary"
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Summary" Then
                       If Application.CountA(Sheets("Summary").Range("A1:A15").EntireRow) = 0 Then
                sh.Range("A15:AF15").Copy Sheets("Summary").Range("A1")
            End If
            sh.Range("A16", sh.Range("AF16").End(xlDown)).Copy
            r = sh.Range("A16", sh.Range("AF16").End(xlDown)).Rows.Count
            Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2).Offset(0, 32).Resize(r, 1) = "Sheet " & sh.Name
            Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
        End If
    Next
End Sub

Dear JLGWhiz,
Sorry to revive this old thread but my query is exactly similar to this one except for some parameters:
I try to adjust the VBA code base on my data parameters and the result is that it is only copying 2 rows of data from each worksheets. also, there's no worksheet name on the last colum of the newly created "summary" worksheet.

Here's my data parameters:
My data has consistent number of columns from A to R only
Row number/qty are varying
Data starts from row 41 (with header) or 42 without header

My data is Costed Bill of Materials for each product
I also what the format (colors and fonts) of each worksheet carry over to the summary not "paste values".

Thanks in advance for your help.