Consolidate Multiple Worksheets Into One

Hello all,

I have attempted to code a "capture" worksheet that will consolidate other worksheets into an importable template. The problem i'm having is when I run my code I beleive it is referenceing the capture page, instead of the other worksheets. I know there are a few ways to accomplish this, one being to reference the other pages through name or location. This will not work as the other sheet names and locations will change, the only constant is the page where all will be consolidated "change capture".

I beleive it is misreferencing as it points to a being 256, and b being 0... both should have different values.

I would like the capture page to consolidate downwards (begin the second paste after the last line of the previous paste).

Thank you in advance for your help!

Dim ws As Worksheet, nrow As Integer
Dim a As Integer, b As Integer
nrow = 2
For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = "Change Capture" Then
        a = Range(Cells(5, 2), Cells(5, 2).End(xlToRight)).Columns.Count + 1

        b = Range(Cells(5, 2), Cells(5, 2).End(xlDown)).Rows.Count + 4

        ws.Range(Cells(5, 2), Cells(b, a)).Copy
        Worksheets("Change Capture").Cells(nrow, a - 1).PasteSpecial Paste:=xlPasteValues
        nrow = Worksheets("Change Capture").Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Rows.Count + 1
    End If
Next ws
Application.CutCopyMode = False

Maybe like this:

Sub x()
    Dim wks     As Worksheet
    Dim nRow    As Long
    Dim iCol    As Long
    Dim iRow    As Long

    nRow = 2

    For Each wks In ThisWorkbook.Worksheets
        If wks.Name <> "Change Capture" Then
            With wks
                iCol = .Range(Cells(5, 2), .Cells(5, 2).End(xlToRight)).Columns.Count + 1
                iRow = .Range(Cells(5, 2), .Cells(5, 2).End(xlDown)).Rows.Count + 4
                .Range(.Cells(5, 2), .Cells(iRow, iCol)).Copy
            End With
            With Worksheets("Change Capture")
                .Cells(nRow, iCol - 1).PasteSpecial Paste:=xlPasteValues
                nRow = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Rows.Count + 1
            End With
        End If
    Next wks
    Application.CutCopyMode = False
End Sub

DGA2008,

It would help if you could post your workbook - scroll down and see "Manage Attachments".


I stepped thru code, and some data in sheet1, 2, 3.

After the first copy from sheet1, "nrow" had a value of 65536. This will prevent the paste for other sheets, and the error.


Have a great day,
Stan

DGA2008,

Your original workbook VBA area was Password Protected. I copied the sheets to a new workbook.

See the attached workbook "Tracking_Dist(1) - DGA2008 - SDG.xls", with a new macro "CopySheets".

Run macro "CopySheets".


Have a great day,
Stan

Would you please mark the thread as Solved?

Click the Edit button on your first post in the thread

Click Go Advanced, select [SOLVED] from the Prefix dropdown, then click Save Changes