VBA to loop through multiple worksheets

[DrH100]

Hi

I'm looking for some help to write a code to complete the same task across a number of worksheets and have no idea where to start.

Basically I have 20 Worksheets currently. The first one is called "index", then I have 17 called App1, App2, App3 etc up to App17 and a final two called Collate and register.

What I want to do is to copy cells A2:E2 from App1 and paste it in the next blank row of "index". I then want to do the same in App2 and so on to App17 and then stop. I don't want it to do the same in index,Collate or Register.

in the past i have used something like (this is from something else I am using at the moment)

Sheets("App1").Select
    Range("a2:e2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Range("a1").Select
    Sheets("index").Select
    Range("a2").Select
    ActiveSheet.Paste
    
    Sheets("App2").Select
    Range("a2:e2").Select
    Application.CutCopyMode = False
    Selection.COPY
    Range("a1").Select
    Sheets("index").Select
    Range("a2").Select
    ActiveSheet.Paste

Is there a way without having to write code for each sheet (which seems very inefficient) to complete the same task but ignore the three other tabs.

Many thanks for any help you can offer

 

[lancerj017]

Try not tested

sub LoopThruWsheet()
Dim i as long, lr as long
Dim ws as worksheet
with activeworkbook
    set ws = .worksheets("index")
    for i = 1 to 17
        lr = ws.cells(rows.count,"A").end(xlup).row
        .worksheets("App"&i).range("A2:E2").copy destination:=ws.range("A" & lr + 1)        
    next i


End with
End sub

 

[DrH100]

That does seem to work, Thanks.

Is it possible to change the paste to PasteValue as some of the cells appear to be formulas?

 

[lancerj017]

Then try this

Sub LoopThruWsheet()
Dim i As Long, lr As Long
Dim ws As Worksheet
With ActiveWorkbook
    Set ws = .Worksheets("index")
    For i = 1 To 17
        lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
        ws.Range("A" & lr + 1).Value = .Worksheets("App" & i).Range("A2").Value
        ws.Range("B" & lr + 1).Value = .Worksheets("App" & i).Range("B2").Value
        ws.Range("C" & lr + 1).Value = .Worksheets("App" & i).Range("C2").Value
        ws.Range("D" & lr + 1).Value = .Worksheets("App" & i).Range("D2").Value
        ws.Range("E" & lr + 1).Value = .Worksheets("App" & i).Range("E2").Value
    Next i
End With
End Sub

 

[mcbrave]

Hi
Im trying to adapt this code.
My problem is similar to this but my sheets change names every day... is there's a way to loop trough the workbook and copy a range from every sheet without knowing the names of the sheets, or using a list with the sheets names as a reference?
Thanks
McB