Looping through worksheets

**ravishankar** · 11-19-2008, 06:21 AM

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

**terkel** · 11-19-2008, 09:45 PM

Hi Ravi
It's nearly working I think but there's a sheet in "PER01" called 'Menu' that needs to be excluded from the process. This sheet is causing the copy/paste process to paste incorrectly. I've tried to exclude the sheet "Menu" by inserting the code below into what you have provided but when the code just activates "PER01" then stops. If I step through the macro I can see that it skips your code entirely and just goes to the 'End If' statement. Can you tell me how to make it read what you have provided.

Code below.

Many thanks for your assisitance

Terk

Sub consolidate()

Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Per01.xls")
Set ws = wb.Worksheets("Menu")


Dim a As Long, b As Long, z As Long
wb.Activate
If ws.Name <> "Menu" Then
For a = 1 To Workbooks("Per01.xls").Sheets.Count - 1
Workbooks("Per01.xls").Worksheets(a).Range("B1:AX91").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 If

End Sub

**ravishankar** · 11-19-2008, 11:13 PM

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

**terkel** · 11-20-2008, 10:07 PM

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

**terkel** · 11-25-2008, 03:54 AM

Hi there
First of all, I'm a bit disappointed that no-one replied to my last post when I was seeking further help on this problem. But then again, because of that I took the code that Mr Ravishankar had kindly provided me with and worked with that until I finally came up with the solution. The final code that works as I want it to is as follows:

Sub consolidate()
Dim a As Long, b As Long, z As Long
Application.ScreenUpdating = False
Workbooks("Per01.xls").Activate 'Added this line as otherwise sheet'Menu' was still being copied.
For a = 1 To Workbooks("Per01.xls").Sheets.Count ' Deleted the 1 after Count which was in original code from Ravi as this prevented last page from being copied.
If Worksheets(a).Name <> "Menu" Then
Workbooks("Per01.xls").Worksheets(a).Range("B1:AX9").Copy
b = Round((a / 5) + 0.25, 0) 'Ravi's original code had 0.5.  This did not copy the sheets in the correct sequence so by trial and error I reduced it to 0.25 which then worked.
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

I could never in a hundred years have come up with the clever initial code supplied by Mr Ravishankar so thanks for the help provided and I'm sure I'll be back with more problems.

Terk