S
salgud
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").PasteSpecial 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
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").PasteSpecial 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