Need help.
I'm sure a better solution exists but I have double loop going.
The intent is copy and save data from multiple sheets, however the data to be copied are not uniform chunks.
I think the problem is that the macro is looping the second time before it saves and reaches next. The outcome is a file saved with the data in the prior loop.
code below:
Dim i As Integer
Dim accts() As String
Dim acct As String
Dim months() As String
Dim month As String
Dim templatepath As String
Dim reportPath As String
Dim templatename As String
Dim count As Integer
Dim count2 As Integer
templatepath = "G:\vender1\MENS\ROS Validation\Templates\"
reportPath = "G:\vender1\MENS\ROS Validation\"
templatename = "ZZ ROS Validation Template 2009"
Workbooks.Open Filename:=templatepath & templatename
Windows("Report macro.xls").Activate
Sheets("Key").Select
Range("A2").Select '[A2 since A1 is Header]
'[Populate list names]
i = 0
Do Until IsEmpty(ActiveCell)
'Redim the array
ReDim Preserve accts(i)
ReDim Preserve months(i)
accts(i) = ActiveCell.Value
months(i) = ActiveCell.Offset(0, 1).Value
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
For i = 0 To UBound(accts)
'[Get the list name]
month = months(i)
acct = accts(i)
' [Get account name]
Windows("ZZ ROS Validation Template 2009.xls").Activate
Sheets("work").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = acct
' [Select tabs to copy]
Windows("ZZ ROS Validation Template 2009.xls").Activate
Sheets(Array("sheet a", "sheet b", "sheet c", "sheet d", "sheet e", "sheet f")).Copy
' [CopyPasteValues tabs]
Sheets(Array("sheet b", "sheet d")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' CopyRows
count = 9
count2 = 19
Sheets(Array("Sheet A", "Sheet C", "Sheet E", "Sheet f")).Select
Sheets("Work").Activate
Do Until count = 399
Rows(count & ":" & count2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
count = count + 30
count2 = count2 + 30
Loop
'[Save the file]
ChDir reportPath
ActiveWorkbook.SaveAs Filename:=reportPath & acct & " " & month & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'[Close saved file]
Windows(acct & " " & month & ".xls").Activate
ActiveWindow.Close
Next
Help is greatly appreciated
I'm sure a better solution exists but I have double loop going.
The intent is copy and save data from multiple sheets, however the data to be copied are not uniform chunks.
I think the problem is that the macro is looping the second time before it saves and reaches next. The outcome is a file saved with the data in the prior loop.
code below:
Dim i As Integer
Dim accts() As String
Dim acct As String
Dim months() As String
Dim month As String
Dim templatepath As String
Dim reportPath As String
Dim templatename As String
Dim count As Integer
Dim count2 As Integer
templatepath = "G:\vender1\MENS\ROS Validation\Templates\"
reportPath = "G:\vender1\MENS\ROS Validation\"
templatename = "ZZ ROS Validation Template 2009"
Workbooks.Open Filename:=templatepath & templatename
Windows("Report macro.xls").Activate
Sheets("Key").Select
Range("A2").Select '[A2 since A1 is Header]
'[Populate list names]
i = 0
Do Until IsEmpty(ActiveCell)
'Redim the array
ReDim Preserve accts(i)
ReDim Preserve months(i)
accts(i) = ActiveCell.Value
months(i) = ActiveCell.Offset(0, 1).Value
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
For i = 0 To UBound(accts)
'[Get the list name]
month = months(i)
acct = accts(i)
' [Get account name]
Windows("ZZ ROS Validation Template 2009.xls").Activate
Sheets("work").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = acct
' [Select tabs to copy]
Windows("ZZ ROS Validation Template 2009.xls").Activate
Sheets(Array("sheet a", "sheet b", "sheet c", "sheet d", "sheet e", "sheet f")).Copy
' [CopyPasteValues tabs]
Sheets(Array("sheet b", "sheet d")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' CopyRows
count = 9
count2 = 19
Sheets(Array("Sheet A", "Sheet C", "Sheet E", "Sheet f")).Select
Sheets("Work").Activate
Do Until count = 399
Rows(count & ":" & count2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
count = count + 30
count2 = count2 + 30
Loop
'[Save the file]
ChDir reportPath
ActiveWorkbook.SaveAs Filename:=reportPath & acct & " " & month & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'[Close saved file]
Windows(acct & " " & month & ".xls").Activate
ActiveWindow.Close
Next
Help is greatly appreciated