Question

I've googled this but couldn't find a clear answer.

I have a workbook that contains lots of sheets, each sheet contains purchase order info. I want to copy the same cell range from each sheet and compile a long list of all of those ranges.

my codes is currently;

Sub WorksheetLoop()


    Sheets("5040001253").Select
    Range("A4:O23").Select
    Selection.Copy
    Sheets("PO_Combi").Select

lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

ActiveSheet.Range("A" & lastRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


End Sub

My question is: is there a simple command that allows to replace the sheet named 5040001253 with that will make this macro repeat on all sheets? If not, could someone tell me what to do to make it so?

Was it helpful?

Solution

Next code copies Range("A4:O23") from each sheet (except PO_Combi) to column A of sheet PO_Combi:

Sub WorksheetLoop()
    Dim sh As Worksheet
    Dim shCombi As Worksheet
    Dim lastrow As Long

    Set shCombi = ThisWorkbook.Worksheets("PO_Combi")

    For Each sh In ThisWorkbook.Worksheets
        With shCombi
            If sh.Name <> .Name Then
                lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
                sh.Range("A4:O23").Copy
                .Range("A" & lastrow + 1).PasteSpecial xlPasteValues
            End If
        End With
    Next

    Application.CutCopyMode = False
End Sub
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top