Consolidate multiples rows in one sheet-CodePudding

Please kindly give me some help, multiples sheets need to copy in one sheet name Report. I am using below code but it's not copy. My excel file contained sheet 1 until sheet 8, column A and Column B rows always change the data.

    Sub Consolidate()

    Dim i As Integer
    
    For i = 1 to Worksheets.Count = 1
    
    Worksheets(1).Select
    Range("A1").Select
    Range(Selection, Selection.End(x1Down)).Select
    Range(Selection, Selection.End(x1TopRight)).Select
    Selection.Copy
    
    Worksheets("Report").Select
    Range("A1048576").Select
    Selection.End(x1Up).Select
    ActiveCell.Offset(1,0).Select
    ActiveSheet.Paste
    
    Next i
    
    End sub

Please check the attached.

enter image description here

Please sheet Report

CodePudding user response：

The following is one way to approach what you're trying to do:

Sub Consolidate()

    Dim i%, inTgtCol%, lgLR&

''' Init target colomn as -1 (so 1st paste below will be to column 1)
    inTgtCol = -1

    For i = 1 To Worksheets.Count: With Worksheets(i)
    
    ''' Process all sheets except Report
        If .Name <> "Report" Then
    
        ''' Get last non-empty cell in column A
        ''' Copy from A1 to corresponding last row in column B
            lgLR = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A1", "B" & lgLR).Copy
                
        ''' Increment target column and Paste to Report
        ''' (column 1, column 3, etc., for each sheet copied)
            inTgtCol = inTgtCol   2
            Worksheets("Report").Cells(1, inTgtCol).PasteSpecial Paste:=xlAll
        
        End If
    
    End With: Next i

End Sub

If the source sheet's data is more than one column the above can be edited to address that. If you need help with that, state how many columns or say 'it's variable' if that's the case.