Looping through worksheets

Hi there
This looping is driving me loopy. I hope some one can tell me what I’m doing wrong. I’ve searched the topic but can’t find anything that helps me sufficiently.
I have a workbook (“Per01.xls”) with 21 sheets in it, each one with a name tab with a different date plus one called ‘Menu’. These sheets are locked and password protected and I don’t know the password. I’m copying parts of each sheet into a new workbook(“Per01Combined.xls”). This workbook has 4 sheets in it called Wk 1, Wk2 etc. I copy the data I need from the first 5 sheets from “Per01.xls” into sheet Wk1 in “Per01Combined.xls”, then the next 5 sheets from “Per01.xls” into sheet Wk2 in “Per01Combined.xls etc. I have set up and modified a macro to do this and it works perfectly but need to run it 20 times with a lot of clicking backwards and forwards between workbooks so I want to be able to loop through the worksheets to do it. With the code I have it copies the page active sheet in “Per01.xls” 20 times into the active sheet in “Per01.xks combined”i nstead of copying each of the 20 pages just once.

Can anyone tell me the code I need to use to
a) have it copy each sheet just once; and
b) have it copy the first 5 sheets into Wk1, the next 5 into Wk2 etc.

Below is the code I am using:

Sub CombineTSO1Data()
    Dim IntBlankRow As Integer
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = Workbooks("Per01.xls")

    If ws.Name <> "Menu" Then
    For Each ws In wb.Worksheets

    Workbooks("Per01.xls").Activate
    Range("B1:AV1").Copy
    Workbooks("Per01Combined.xls").Activate
    IntBlankRow = WorksheetFunction.CountA(Range("A:A")) + 1
    Cells(IntBlankRow, 1).Select
    ActiveSheet.Paste
    Workbooks("Per01.xls").Activate
    Range("B2:AX2").Copy
   'Rest of code that does copying.  This all works ok
    Workbooks("Per01.xls").Activate

    Next ws
       End If


End Sub

As always, thanks for the great assistance received from this forum.

Hi
Open both files and paste these codes into per01.xls and run the macro.

Sub consolidate()
Dim a As Long, b As Long, z As Long
For a = 1 To Sheets.Count - 1
Worksheets(a).Range("B1:AV1").Copy
b = Round((a / 5) + 0.5, 0)
z = Workbooks("Per01Combined.xls").Worksheets("WK" & b).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks("Per01Combined.xls").Worksheets("WK" & b).Range("A" & z + 1).PasteSpecial
Next a
End Sub

If you get an error check for spaces in sheet name like WK 1 instead of WK1
Ravi

Hi Ravi
Thanks for that advice - but before I try it I forgot to mention that I run the macro from the workbook "Per01.combined.xls". Will that make any differnce to what you have said?

Hi Ravi ,again
I just tried to do what you advised but then realised that "Per01.xls" is password protected. Everything has to be run from "Per01Combined.xls".

Thanks
Terk

Hi
try this modification from combined file

Sub consolidate()
Dim a As Long, b As Long, z As Long
For a = 1 To Workbooks("Per01.xls").Sheets.Count - 1
Workbooks("Per01.xls").Worksheets(a).Range("B1:AV1").Copy
b = Round((a / 5) + 0.5, 0)
z = Workbooks("Per01Combined.xls").Worksheets("WK" & b).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks("Per01Combined.xls").Worksheets("WK" & b).Range("A" & z + 1).PasteSpecial
Next a
End Sub

Ravi

Hi

Sub consolidate()
Dim a As Long, b As Long, z As Long
For a = 1 To Workbooks("Per01.xls").Sheets.Count - 1
If Worksheets(a).Name <> "menu" Then
Workbooks("Per01.xls").Worksheets(a).Range("B1:AV1").Copy
b = Round((a / 5) + 0.5, 0)
z = Workbooks("Per01Combined.xls").Worksheets("WK" & b).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks("Per01Combined.xls").Worksheets("WK" & b).Range("A" & z + 1).PasteSpecial
End If
Next a
End Sub

Ravi

Hi again Ravi
Thanks so much for persisting with this.
When I tried your code it still picked up the sheet 'Menu' and did all sorts of strange things with the pasting. So I stuck in the line

Workbooks("Per01.xls").Activate

at the top of your code and it now ignores the sheet 'Menu'. However, instead of pasting the first 5 sheets from "PER01" into the sheet 'Wk1' in "PER01Combined, the next 5 into sheet 'Wk2' etc, the following is happening.

Pastes sheets 1 - 3 into Wk1
Pastes sheets 1 - 9 into Wk2
Pastes sheets 1-3; 10-13 into Wk3
Pastes sheets 1-3; 14-19 into Wk4.

Complete code is below. Hope you are able to help.

Terk

Sub consolidate()
Dim a As Long, b As Long, z As Long
Workbooks("Per01.xls").Activate
For a = 1 To Workbooks("Per01.xls").Sheets.Count - 1
If Worksheets(a).Name <> "Menu" Then
Workbooks("Per01.xls").Worksheets(a).Range("B1:AX9").Copy
b = Round((a / 5) + 0.5, 0)
z = Workbooks("Per01Combined.xls").Worksheets("WK" & b).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks("Per01Combined.xls").Worksheets("WK" & b).Range("A" & z + 1).PasteSpecial
End If
Next a

End Sub