C
Chris Maddogz
Currently running the following macro to save multiple worksheets from
workbook "Jobs" to a new workbook with the name in cell E1 of original Jobs
worksheet "Concrete".
Because I am copying cells A:E into the first new worksheet within the new
workbook I then need to make sure that the print layout is identical - ie the
1st worksheet in the new workbook needs to be set to fit to one page (as per
"Concrete" worksheet is setup - just not sure where to insert code
Thanks
Sub savejobC()
' Macro recorded 23/05/2009 by Chris
'
Dim strName As String
Dim strPath As String
Dim strFolder As String
Dim wbTemp As Workbook
Dim varSheets As Variant
varSheets = Array("SubCon C", "Inv C", "Sub C", "Safety C", "Work Method C")
Sheets("CONCRETE").Select
Columns("A:E").Copy
Set wbTemp = Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("Jobs Workbook.xls").Sheets(varSheets).Copy _
After:=wbTemp.Worksheets(1)
wbTemp.Activate
Sheets("Sheet1").Select
strName = Left(Trim(Range("E1")), 3)
strPath = "c:\Jobs\"
If Dir(strPath & strName, vbDirectory) = "" Then
MkDir "c:\jobs\" & strName
End If
ActiveSheet.Name = Trim(Range("E1"))
For Each sh In ActiveWorkbook.Sheets
sh.Activate
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Next sh
Range("A1").Select
Sheets("Safety C").Select
Range("A1").Select
Sheets("Sub C").Select
Range("D9").Select
Sheets("Inv C").Select
Range("E13").Select
Sheets("SubCon C").Select
Range("B6").Select
Sheets(1).Select
Range("E1").Select
ActiveWorkbook.SaveAs "c:\jobs\" & strName & "\" & Trim(Range("E1")) & ".xls"
ActiveWorkbook.Close True
End Sub
workbook "Jobs" to a new workbook with the name in cell E1 of original Jobs
worksheet "Concrete".
Because I am copying cells A:E into the first new worksheet within the new
workbook I then need to make sure that the print layout is identical - ie the
1st worksheet in the new workbook needs to be set to fit to one page (as per
"Concrete" worksheet is setup - just not sure where to insert code
Thanks
Sub savejobC()
' Macro recorded 23/05/2009 by Chris
'
Dim strName As String
Dim strPath As String
Dim strFolder As String
Dim wbTemp As Workbook
Dim varSheets As Variant
varSheets = Array("SubCon C", "Inv C", "Sub C", "Safety C", "Work Method C")
Sheets("CONCRETE").Select
Columns("A:E").Copy
Set wbTemp = Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("Jobs Workbook.xls").Sheets(varSheets).Copy _
After:=wbTemp.Worksheets(1)
wbTemp.Activate
Sheets("Sheet1").Select
strName = Left(Trim(Range("E1")), 3)
strPath = "c:\Jobs\"
If Dir(strPath & strName, vbDirectory) = "" Then
MkDir "c:\jobs\" & strName
End If
ActiveSheet.Name = Trim(Range("E1"))
For Each sh In ActiveWorkbook.Sheets
sh.Activate
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Next sh
Range("A1").Select
Sheets("Safety C").Select
Range("A1").Select
Sheets("Sub C").Select
Range("D9").Select
Sheets("Inv C").Select
Range("E13").Select
Sheets("SubCon C").Select
Range("B6").Select
Sheets(1).Select
Range("E1").Select
ActiveWorkbook.SaveAs "c:\jobs\" & strName & "\" & Trim(Range("E1")) & ".xls"
ActiveWorkbook.Close True
End Sub