This works perfectly but it would be nice if it were written more elegantly.
What it does is open spreadsheet files with month and year as part of the file name. It then copies a specific worksheet from each and pastes it back into a specific page of the spreadsheet that contains the macro. I'm thinking it would be easy to loop but I didn't know how to change my variable names with a loop:
Sub OpenDatedXLS()
'Open Workbooks with Date in Name of File. Add or subtract months
Dim wb, wb1, wb2, wb3, fPath, fName As String
Dim MO1, MO2, MO3, MO4 As Date
fPath = ActiveWorkbook.Path & "\"
fName = ActiveWorkbook.Name
MO1 = Date
MO2 = DateAdd("m", -1, MO1)
MO3 = DateAdd("m", -2, MO1)
MO4 = DateAdd("m", -3, MO1)
sh1 = "SEA" & Format(MO1, "MMYY")
sh2 = "SEA" & Format(MO2, "MMYY")
sh3 = "SEA" & Format(MO3, "MMYY")
sh4 = "SEA" & Format(MO4, "MMYY")
wb1 = "PerDiemRatesForeignAreas_" & Format(MO1, "MMMMYYYY") & "Pd.xls"
wb2 = "PerDiemRatesForeignAreas_" & Format(MO2, "MMMMYYYY") & "Pd.xls"
wb3 = "PerDiemRatesForeignAreas_" & Format(MO3, "MMMMYYYY") & "Pd.xls"
wb4 = "PerDiemRatesForeignAreas_" & Format(MO4, "MMMMYYYY") & "Pd.xls"
Workbooks.Open fPath & wb1
copysheetname = ActiveWorkbook.Name
Worksheets(sh1).UsedRange.Copy
Workbooks(fName).Activate
pasterow = Workbooks(fName).Worksheets("Per Diem Rates").UsedRange.Rows.Count + 1
Workbooks(fName).Worksheets("Per Diem Rates").Range("A" & pasterow).Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Workbooks(copysheetname).Close
Application.DisplayAlerts = True
Workbooks.Open fPath & wb2
copysheetname = ActiveWorkbook.Name
Worksheets(sh2).UsedRange.Copy
Workbooks(fName).Activate
pasterow = Workbooks(fName).Worksheets("Per Diem Rates").UsedRange.Rows.Count + 1
Workbooks(fName).Worksheets("Per Diem Rates").Range("A" & pasterow).Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Workbooks(copysheetname).Close
Application.DisplayAlerts = True
Workbooks.Open fPath & wb3
copysheetname = ActiveWorkbook.Name
Worksheets(sh3).UsedRange.Copy
Workbooks(fName).Activate
pasterow = Workbooks(fName).Worksheets("Per Diem Rates").UsedRange.Rows.Count + 1
Workbooks(fName).Worksheets("Per Diem Rates").Range("A" & pasterow).Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Workbooks(copysheetname).Close
Application.DisplayAlerts = True
Workbooks.Open fPath & wb4
copysheetname = ActiveWorkbook.Name
Worksheets(sh4).UsedRange.Copy
Workbooks(fName).Activate
pasterow = Workbooks(fName).Worksheets("Per Diem Rates").UsedRange.Rows.Count + 1
Workbooks(fName).Worksheets("Per Diem Rates").Range("A" & pasterow).Select
ActiveSheet.Paste
Application.DisplayAlerts = False
Workbooks(copysheetname).Close
Application.DisplayAlerts = True
End Sub
Bookmarks