View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
joecrabtree joecrabtree is offline
external usenet poster
 
Posts: 111
Default Apply maco to multiple worksheets request

All,

I have the following code which runs on a 'data' worksheet summarizes
the data and copies it to the 'output' spreadsheet. This works fine.
However what i would like to do is run it for all sheets which have
the name format 'DATA xxxxxxx' the xxxxxxx is a date with the format
2009.02.11 and this could vary. I would then like to create an
individual output sheet for each DATA worksheet labelled 2009.02.11
OUTPUT etc for each date. How can I modify the code to do this? Thanks
in advance for your help.

Regards,

Joseph Crabtree

Sub summarysheet()




For Each Sh In ThisWorkbook.Worksheets


With Sheets("Data")
LastRow = Sheets("Data").Range("R" & Rows.Count).End(xlUp).Row
Set CodeRange = .Range("R2:R" & LastRow)
Set SumRange = .Range("U2:U" & LastRow)

End With

Sheets("data").Activate
Range("R1", "R" & LastRow).Select
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy Sheets("output").Range("A20")
ActiveSheet.ShowAllData

Set CriteriaRange = Sheets("Output").Range("A21")
For r = 2 To Sheets("Output").Range("A21").End(xlDown).Row
Total = WorksheetFunction.SumIf(CodeRange, CriteriaRange,
SumRange)
CriteriaRange.Offset(0, 1) = Total
Set CriteriaRange = CriteriaRange.Offset(1, 0)
Next



With Sheets("Data")
LastRow = Sheets("Data").Range("R" & Rows.Count).End(xlUp).Row
Set CodeRange = .Range("R2:R" & LastRow)
Set SumRange = .Range("AC2:AC" & LastRow)

End With

Sheets("data").Activate
Range("R1", "R" & LastRow).Select
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
'Selection.Copy Sheets("output").Range("A1")
ActiveSheet.ShowAllData

Sheets("data").Activate
Range("AC1").Select
Selection.Copy Sheets("output").Range("C20")

Sheets("data").Activate
Range("U1").Select
Selection.Copy Sheets("output").Range("B20")


Set CriteriaRange = Sheets("Output").Range("A21")
For r = 2 To Sheets("Output").Range("A21").End(xlDown).Row
Total = WorksheetFunction.SumIf(CodeRange, CriteriaRange,
SumRange)
CriteriaRange.Offset(0, 2) = Total
Set CriteriaRange = CriteriaRange.Offset(1, 0)
Next


End Sub