Selecting data from multiple worksheets

  • Thread starter Thread starter pwk
  • Start date Start date
P

pwk

I am putting together a workbook that consolidates quarterly sales
from many departments by day of week so they may bee seen and averaged
by day of week on one worksheet. The following macro put together for
Saturday does it very well for five departments but its way too
lengthy. Is there a way of paring it down to something more
manageable? I have many more departments and days to insert and
writing this is tedious. The macro I’m using is below. Also, where do
I place Application.CutCopyMode = False to clear the clipboard? The
weeks vary from 9-12 depending on the calendar.

Thanks for your help in advance; I’ve learned a lot from you guys.

Sub CombineSat()
On Error GoTo EndOfMacro
'Week Number
'1
Windows("combined sheets.xls").Activate
Sheets("Sat").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AD4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'2
Windows("combined sheets.xls").Activate
Sheets("Sat (2)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AE4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'3
Windows("combined sheets.xls").Activate
Sheets("Sat (3)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AF4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'4
Windows("combined sheets.xls").Activate
Sheets("Sat (4)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AG4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'5
Windows("combined sheets.xls").Activate
Sheets("Sat (5)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AH4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'6
Windows("combined sheets.xls").Activate
Sheets("Sat (6)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AI4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'7
Windows("combined sheets.xls").Activate
Sheets("Sat (7)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AJ4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'8
Windows("combined sheets.xls").Activate
Sheets("Sat (8)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AK4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'9
Windows("combined sheets.xls").Activate
Sheets("Sat (9)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AL4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'10
Windows("combined sheets.xls").Activate
Sheets("Sat (10)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AM4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'11
Windows("combined sheets.xls").Activate
Sheets("Sat (11)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AN4").Select
Selection.PasteSpecial Paste:=xlPasteValues
'12
Windows("combined sheets.xls").Activate
Sheets("Sat (12)").Select
Range("F6:F11").Select
Selection.Copy
Windows("Consolidated Worksheet.xls").Activate
Range("AO4").Select
Selection.PasteSpecial Paste:=xlPasteValues

EndOfMacro:
Exit Sub


End Sub
 
Hi,

To get this into a loop you need to rethink your sheet naming convention in
the receieving workbook. For example you have

Sheets("Sat")
Sheets("Sat (2)")
Sheets("Sat (3)")
etc

I hope it's a typo and your first sheet is actually
Sheets("Sat (1)")

If you change your first sheet to that then a loop is easy and this does the
same work as all your code.

Sub CombineSat()
Windows("Consolidated Worksheet.xls").Activate
For x = 1 To 12
Workbooks("combined sheets.xls").Sheets("Sat (" & x &
")").Range("F6:F11").Copy
Range("AC4").Offset(, x).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
End Sub


Mike
 
Hi,

To get this into a loop you need to rethink your sheet naming convention in
the receieving workbook. For example you have

Sheets("Sat")
Sheets("Sat (2)")
Sheets("Sat (3)")
etc

I hope it's a typo and your first sheet is actually
Sheets("Sat (1)")

If you change your first sheet to that then a loop is easy and this does the
same work as all your code.

Sub CombineSat()
Windows("Consolidated Worksheet.xls").Activate
For x = 1 To 12
Workbooks("combined sheets.xls").Sheets("Sat (" & x &
")").Range("F6:F11").Copy
Range("AC4").Offset(, x).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
End Sub

Mike









- Show quoted text -
Click to expand...

It is not Sat (1). Is there a quick way to add (1) to Mon thru Sat
tabs so I may easily use your macro. Thanks for your Quick response.
I've got a lot to learn, but, I’ve come a long way thanks to folks
like you willing to share your time and expertise.
 
It is not Sat (1). Is there a quick way to add (1) to Mon thru Sat
tabs so I may easily use your macro. Thanks for your Quick response.
I've got a lot to learn, but, I’ve come a long way thanks to folks
like you willing to share your time and expertise.- Hide quoted text -

- Show quoted text -
Click to expand...

In regards to the Sat to Sat (1) query. I used the following to rename
sheets, lacking a easier way.

Sub RenameSheets()

Sheets("Mon").Name = "Mon (1)"
Sheets("Tues").Name = "Tues (1)"
Sheets("Wed").Name = "Wed (1)"
Sheets("Thur").Name = "Thur(1)"
Sheets("Fri").Name = "Fri (1)"
Sheets("Sat").Name = "Sat (1)"

End Sub
 
Hi,

You could actually have got that into a loop but given that it's a one off
no real need.

Mike
 
Hi,

To get this into a loop you need to rethink your sheet naming convention in
the receieving workbook. For example you have

Sheets("Sat")
Sheets("Sat (2)")
Sheets("Sat (3)")
etc

I hope it's a typo and your first sheet is actually
Sheets("Sat (1)")

If you change your first sheet to that then a loop is easy and this does the
same work as all your code.

Sub CombineSat()
Windows("Consolidated Worksheet.xls").Activate
For x = 1 To 12
Workbooks("combined sheets.xls").Sheets("Sat (" & x &
")").Range("F6:F11").Copy
Range("AC4").Offset(, x).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
End Sub

Mike









- Show quoted text -
Click to expand...

Rather than rewrite this code for each day Mon thru Sat Is there a way
to 'plug in' the day to replace Sat in the remaining macros? Thinking
about it, I bet you knew was going to ask that. Thanks a lot. Paul

I hope I posted this correctly.
 
Back
Top