VB loop help, file not saving correctly

[melusive]

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

 

[BrianB]

Generally we do not have time to read large amounts of code that are not correctly formatted and comments added.