A
andrea
I am having trouble getting my code for copying worksheets from one
workbook to another to work. Here is my code in its entirety:
Sub Save_Report()
Dim rngAllFiles(), rngSelectFiles(), m, fileSaveName, wkshtName As
Variant
Dim a, s, i As Integer
Dim newBook As Object
rngAllFiles = Array("1 Cover.xls", "2 Table of Contents.xls", "3 Top
Ten.xls", "4 FX Impact.xls", "5A MTD IS.xls", "5B QTD IS.xls", "5C YTD
IS.xls", "6 Sales-Internal.xls", "7 Sales-WS.xls", "8A MTD GM.xls", "8B
QTD GM.xls", "8C YTD GM.xls", "9 Op Exp by Location.xls", "10 RD Exp by
Month.xls", "11 AZ versus Pr. Year.xls", "12 AZ versus Budgdt.xls", "13
Payroll by BU.xls", "14 PR Tax by BU.xls", "15 Supplies by BU.xls", "16
Catalog by BU.xls", "17 R&M by BU.xls", "18 A&P by BU.xls", "19 T&E
BU.xls", "20 LP&C BU.xls", "21 R&H by BU.xls", "22 Headcount.xls", "23
Payroll by Location.xls", "24 Payroll versus Pr. Year.xls", "25 Payroll
versus Budget.xls", "26 BS.xls", "27 AR.xls", "28 Inventory.xls", "29
Cap Ex.xls")
a = 0
s = 0
i = Workbooks("Save_Final_Op_Summary.xls").Worksheets("Save Final
Report").Cells(40, 2)
If i = 1 Then
ReDim rngSelectFiles(i)
Else: ReDim rngSelectFiles(i - 1)
End If
For r = 7 To 39
If ActiveSheet.Cells(r, 2) = "True" Then
rngSelectFiles(s) = rngAllFiles(a)
s = s + 1
Else: End If
a = a + 1
Next r
Set newBook = Workbooks.Add
fileSaveName = Application.GetSaveAsFilename("newBook", "Microsoft
Excel Workbook (*.xls), *.xls")
newBook.SaveAs Filename:=fileSaveName
For Each m In rngSelectFiles
Workbooks.Open Filename:=m
Workbooks(m).Sheets(1).Copy
before:=Workbooks(fileSaveName).Sheets(1)
fileSaveName.Activate
ActiveSheet.UsedRange.PasteSpecial Paste:=xlPasteValues
Next m
End Sub
I am getting a subscript out of range error on this line
"Workbooks(m).Sheets(1).Copy
before:=Workbooks(fileSaveName).Sheets(1)".
Can anyone help me with this?
Thx,
workbook to another to work. Here is my code in its entirety:
Sub Save_Report()
Dim rngAllFiles(), rngSelectFiles(), m, fileSaveName, wkshtName As
Variant
Dim a, s, i As Integer
Dim newBook As Object
rngAllFiles = Array("1 Cover.xls", "2 Table of Contents.xls", "3 Top
Ten.xls", "4 FX Impact.xls", "5A MTD IS.xls", "5B QTD IS.xls", "5C YTD
IS.xls", "6 Sales-Internal.xls", "7 Sales-WS.xls", "8A MTD GM.xls", "8B
QTD GM.xls", "8C YTD GM.xls", "9 Op Exp by Location.xls", "10 RD Exp by
Month.xls", "11 AZ versus Pr. Year.xls", "12 AZ versus Budgdt.xls", "13
Payroll by BU.xls", "14 PR Tax by BU.xls", "15 Supplies by BU.xls", "16
Catalog by BU.xls", "17 R&M by BU.xls", "18 A&P by BU.xls", "19 T&E
BU.xls", "20 LP&C BU.xls", "21 R&H by BU.xls", "22 Headcount.xls", "23
Payroll by Location.xls", "24 Payroll versus Pr. Year.xls", "25 Payroll
versus Budget.xls", "26 BS.xls", "27 AR.xls", "28 Inventory.xls", "29
Cap Ex.xls")
a = 0
s = 0
i = Workbooks("Save_Final_Op_Summary.xls").Worksheets("Save Final
Report").Cells(40, 2)
If i = 1 Then
ReDim rngSelectFiles(i)
Else: ReDim rngSelectFiles(i - 1)
End If
For r = 7 To 39
If ActiveSheet.Cells(r, 2) = "True" Then
rngSelectFiles(s) = rngAllFiles(a)
s = s + 1
Else: End If
a = a + 1
Next r
Set newBook = Workbooks.Add
fileSaveName = Application.GetSaveAsFilename("newBook", "Microsoft
Excel Workbook (*.xls), *.xls")
newBook.SaveAs Filename:=fileSaveName
For Each m In rngSelectFiles
Workbooks.Open Filename:=m
Workbooks(m).Sheets(1).Copy
before:=Workbooks(fileSaveName).Sheets(1)
fileSaveName.Activate
ActiveSheet.UsedRange.PasteSpecial Paste:=xlPasteValues
Next m
End Sub
I am getting a subscript out of range error on this line
"Workbooks(m).Sheets(1).Copy
before:=Workbooks(fileSaveName).Sheets(1)".
Can anyone help me with this?
Thx,