Copy ws to new wb, loop for each ws

[JC]

Hey Y'all,

Thanks in advance!

I have 6 workbooks. Each workbook has 29 worksheets, one for each division.
I need to extract each divisions worksheet from all 6 of the workbooks, and
consolidate them into a division workbook. The code I have works, but it's
too big if I try to recreate it for each of the divisions.

So, I figure a loop will be more efficient if I set up a range with each
divisions code, but I need help with inserting the result from the loop into
the filepath and ws names.

Here my code

Sub Mission()

'
' Sub Mission breaks these damn workbooks apart, consolidates them by
division, then saves as .pdf.
'

'
' Select the divisions worksheet from the LEAD Workbook, copy it to a new
workbook and save it in the divisions folder.
'
Windows("FY 2010 P&L - Lead.xlsm").Activate
Sheets("IM LEAD").Select
Sheets("IM LEAD").Copy
ChDir "W:\Budget Monitoring\P&L\FY2010\Reports\IM"
ActiveWorkbook.SaveAs Filename:= _
"W:\Budget Monitoring\P&L\FY2010\Reports\IM\FY10 IM Actual to Budget
Report - " & Format(DateAdd("m", -1, Now), "mmm yy") _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'
' Move to each workbook and copy the divisions worksheet into the division's
saved report
'
Windows("All Funds Expenditure Report.xlsm").Activate
Sheets("IM All Funds Exp").Select
Sheets("IM All Funds Exp").Copy After:=Workbooks( _
"FY10 IM Actual to Budget Report - " & Format(DateAdd("m", -1, Now),
"mmm yy") & ".xlsx").Sheets(1)
Windows("FY 2010 P&L - MSP.xlsm").Activate
Sheets("IM MSP Summary").Select
Sheets("IM MSP Summary").Copy After:=Workbooks( _
"FY10 IM Actual to Budget Report - " & Format(DateAdd("m", -1, Now),
"mmm yy") & ".xlsx").Sheets(2)
Windows("FY 2010 P&L - NIH.xlsm").Activate
Sheets("IM NIH Summary").Select
Sheets("IM NIH Summary").Copy After:=Workbooks( _
"FY10 IM Actual to Budget Report - " & Format(DateAdd("m", -1, Now),
"mmm yy") & ".xlsx").Sheets(3)
Windows("FY 2010 P&L - Grants and Contracts.xlsm").Activate
Sheets("IM G&C Summary").Select
Sheets("IM G&C Summary").Copy After:=Workbooks( _
"FY10 IM Actual to Budget Report - " & Format(DateAdd("m", -1, Now),
"mmm yy") & ".xlsx").Sheets(4)
Windows("FY 2010 P&L - Endowments.xlsm").Activate
Sheets("IM Endow Summary").Select
Sheets("IM Endow Summary").Copy After:=Workbooks( _
"FY10 IM Actual to Budget Report - " & Format(DateAdd("m", -1, Now),
"mmm yy") & ".xlsx").Sheets(5)
Sheets("IM LEAD").Select

'
' Save the file, publish to PDF, and close.
'

ActiveWorkbook.Save
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"W:\Budget Monitoring\P&L\FY2010\Reports\IM\FY10 IM Actual to Budget
Report - " & Format(DateAdd("m", -1, Now), "mmm yy") & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True,
IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Workbooks("FY10 IM Actual to Budget Report - " &
Format(DateAdd("m", -1, Now), "mmm yy")).Close

Windows("FY 2010 P&L - LEAD").Activate


End Sub

My divisions are IM, IM2, IM3...IM28.

Your help is very much appreciated,

Justin

 

[joel]

Try this


Sub Mission()

'
' Sub Mission breaks these damn workbooks apart, consolidates them by
'division, then saves as .pdf.
'
Folder = "W:\Budget Monitoring\P&L\FY2010\Reports\IM\"

bkNames = Array("FY 2010 P&L - Lead.xlsm", _
"All Funds Expenditure Report.xlsm", _
"FY 2010 P&L - MSP.xlsm", _
"FY 2010 P&L - NIH.xlsm", _
"FY 2010 P&L - Grants and Contracts.xlsm", _
"FY 2010 P&L - Endowments.xlsm")


For Each bkName In bkNames
Set bk = Workbooks.Open(Filename:=Folder & bkName)

For Each sht In bk.Sheets
With ThisWorkbook
sht.Copy after:=.Sheets(.Sheets.Count)
End With
Next sht

bk.Close savechanges:=False
Next bkName


ThisWorkbook.SaveAs Filename:= _
Folder & "FY10 IM Actual to Budget Report - " & _
Format(DateAdd("m", -1, Now), "mmm yy"), _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False

End Sub