D
davegb
I'm working on a macro to open a series of files in the same directory,
copy the page, then paste each page into a corresponding sheet with a
corresponding name in a different workbook.
'Change to appropriate method and file
Set wbPIP = Workbooks("PIP Test1.xls")
frmYrQtrInput.Show
sDirMod = "H:\AllDocs\CFSR PIP DD\SFY " & sCurYr & Space(1) & _
"Q" & sCurQtr & "\Records Mod\"
sFName = Dir(sDirMod)
lFileCt = 0
Do Until sFName = ""
Set wb = Workbooks(sFName) <-----SUBSCRIPT OUT OF RANGE
wb(sFName).Open
Selection.CurrentRegion.Select
Selection.Copy
sShtName = Left(sFName, Len(sFName) - 7)
sShtName = sShtName & "Records"
wbPIP.Activate
wbPIP.Worksheets(sShtName).Activate
'Range("b2").Select 'TEST
Selection.CurrentRegion.Select
Selection.Clear
Range("A1").Select
Selection.Paste
lFileCt = lFileCt + 1
sFName = Dir()
Loop
MsgBox (lFileCt & " files were copied to the PIP spreadsheet."),
vbOKOnly
Application.ScreenUpdating = True
End Sub
Help! And thanks.
copy the page, then paste each page into a corresponding sheet with a
corresponding name in a different workbook.
'Change to appropriate method and file
Set wbPIP = Workbooks("PIP Test1.xls")
frmYrQtrInput.Show
sDirMod = "H:\AllDocs\CFSR PIP DD\SFY " & sCurYr & Space(1) & _
"Q" & sCurQtr & "\Records Mod\"
sFName = Dir(sDirMod)
lFileCt = 0
Do Until sFName = ""
Set wb = Workbooks(sFName) <-----SUBSCRIPT OUT OF RANGE
wb(sFName).Open
Selection.CurrentRegion.Select
Selection.Copy
sShtName = Left(sFName, Len(sFName) - 7)
sShtName = sShtName & "Records"
wbPIP.Activate
wbPIP.Worksheets(sShtName).Activate
'Range("b2").Select 'TEST
Selection.CurrentRegion.Select
Selection.Clear
Range("A1").Select
Selection.Paste
lFileCt = lFileCt + 1
sFName = Dir()
Loop
MsgBox (lFileCt & " files were copied to the PIP spreadsheet."),
vbOKOnly
Application.ScreenUpdating = True
End Sub
Help! And thanks.