The following code takes data from one spreadsheet and transfers it to
another series of workbooks it creates from the list in the source
workbook.

Sub CreateMitigWS()

'Validate worksheets present
Dim wbSourceA As Workbook
Dim wsSourceA As Worksheet
Dim wsSourceB As Worksheet
Dim wsTemplate As Worksheet '(contains macro)
Dim wbCty As Workbook
Dim sCty As String
Dim iCtyRow As Integer

Set wbSourceA = Workbooks("SFY2009 Mitigation Datasource(version1).xls")
'"Subscript out of range"
Set wsSourceA = wbSourceA.Worksheets("CoVR_ModelImportDataBOS")
'set wbsourceB =
'wsSourceA Insert blank columns in cols E, then 2 blank cols at D and E
wsSourceA.Columns("E:E").Insert
wsSourceA.Columns("D:E").Insert

iCtyRow = 3

Do
sCty = wsSourceA.Range("A" & iCtyRow)
Set wbCty = Workbooks.Add '(workbook created for each county)
wbCty.SaveAs Filename:=sCty & " Mitigation Data SFY2009"
ThisWorkbook.Worksheets("Source").Range("A1:F33"). Copy
Destination:=wbCty.ActiveSheet.Range("A1")
wsSourceA.Range("B" & iCtyRow & ":N" & iCtyRow).Copy
wbCty.Worksheets("Sheet1").Range("B5").PasteSpecia l Paste:=xlPasteValues,
_
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
wbCty.Worksheets("Sheet1").Range("A1").Value = "County Name: " & sCty
'Reformat the col A width and all row heigths
Columns("A:A").ColumnWidth = 36.57
Cells.Select
Cells.EntireRow.AutoFit

iCtyRow = iCtyRow + 1
Loop Until sCty = "Baca"

iCtyRow = iCtyRow - 3
MsgBox "You have created " & iCtyRow & " files!", vbOKOnly

End Sub

This code ran fine until I moved the worksheet with the code and the other
worksheet to a different directory on a different drive. So they are both
still in the same folder, but a different one from where they were created.
I thought that as long as they were in the same folder, they'd work.
Apparently not. Any ideas on how to get them to?

TIA

On Wed, 13 May 2009 10:45:43 -0600, salgud wrote:

The following code takes data from one spreadsheet and transfers it to
another series of workbooks it creates from the list in the source
workbook.

Sub CreateMitigWS()

'Validate worksheets present
Dim wbSourceA As Workbook
Dim wsSourceA As Worksheet
Dim wsSourceB As Worksheet
Dim wsTemplate As Worksheet '(contains macro)
Dim wbCty As Workbook
Dim sCty As String
Dim iCtyRow As Integer

Set wbSourceA = Workbooks("SFY2009 Mitigation Datasource(version1).xls")
'"Subscript out of range"
Set wsSourceA = wbSourceA.Worksheets("CoVR_ModelImportDataBOS")
'set wbsourceB =
'wsSourceA Insert blank columns in cols E, then 2 blank cols at D and E
wsSourceA.Columns("E:E").Insert
wsSourceA.Columns("D:E").Insert

iCtyRow = 3

Do
sCty = wsSourceA.Range("A" & iCtyRow)
Set wbCty = Workbooks.Add '(workbook created for each county)
wbCty.SaveAs Filename:=sCty & " Mitigation Data SFY2009"
ThisWorkbook.Worksheets("Source").Range("A1:F33"). Copy
Destination:=wbCty.ActiveSheet.Range("A1")
wsSourceA.Range("B" & iCtyRow & ":N" & iCtyRow).Copy
wbCty.Worksheets("Sheet1").Range("B5").PasteSpecia l Paste:=xlPasteValues,
_
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
wbCty.Worksheets("Sheet1").Range("A1").Value = "County Name: " & sCty
'Reformat the col A width and all row heigths
Columns("A:A").ColumnWidth = 36.57
Cells.Select
Cells.EntireRow.AutoFit

iCtyRow = iCtyRow + 1
Loop Until sCty = "Baca"

iCtyRow = iCtyRow - 3
MsgBox "You have created " & iCtyRow & " files!", vbOKOnly

End Sub

This code ran fine until I moved the worksheet with the code and the other
worksheet to a different directory on a different drive. So they are both
still in the same folder, but a different one from where they were created.
I thought that as long as they were in the same folder, they'd work.
Apparently not. Any ideas on how to get them to?

TIA

Nevermind! Found a missing space in the filename. Paniced a bit, got to
have this done by the end of the day.