I need to be able to copy all sheets that are visible (could be 2 sheets to 5
sheets) to a new workbook and give the user the ability to save the file
before closing it. I currently have code to extract one sheet at a time...
but I can't figure out how to put all of them into one workbook. Here's the
code (don't make fun, I've been using VBA for about 6 months) for extracting
a single worksheet. There are links that need to be broken and the print
range needs to be set as well...
Thanks in advance!


Sub ExportSP04cpfReport()
Dim links As Variant
OriginalFileName = Application.ActiveWorkbook.Name
NewFileName = Application.GetSaveAsFilename("SP CPF 04", "Microsoft Excel
(*.xls), *.xls")
If NewFileName = "False" Then
MsgBox "Export Canceled"
Exit Sub
End If
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Name = "SP CPF 04"
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AP$54"
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
Range("A1").Select
' Define variable as an Excel link type.
links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLi nks)
' Break the first link in the active workbook.
ActiveWorkbook.BreakLink _
Name:=links(1), _
Type:=xlLinkTypeExcelLinks
'sets print range
Sheets("SP CPF 04").PageSetup.LeftMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.RightMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.TopMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.BottomMargin =
Application.InchesToPoints(0.5)
Sheets("SP CPF 04").PageSetup.CenterHorizontally = True
Sheets("SP CPF 04").PageSetup.Zoom = 90
Sheets("SP CPF 04").Range("A54") = "Exported from Asphalt Plant
Worksheet"
Sheets("SP CPF 04").Protect password:="xxxx"
ActiveWorkbook.SaveAs Filename:=NewFileName _
, FileFormat:=xlNormal, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub

Dim sh as Worksheet, bReplace as Boolean
bReplace = True
for each sh in Worksheets
if sh.visible = True then
sh.Select Replace:=bReplace
bReplace = False
end if
Next
activewindows.SelectedSheet.copy

--
Regards,
Tom Ogilvy



"Clay" wrote:

I need to be able to copy all sheets that are visible (could be 2 sheets to 5
sheets) to a new workbook and give the user the ability to save the file
before closing it. I currently have code to extract one sheet at a time...
but I can't figure out how to put all of them into one workbook. Here's the
code (don't make fun, I've been using VBA for about 6 months) for extracting
a single worksheet. There are links that need to be broken and the print
range needs to be set as well...
Thanks in advance!


Sub ExportSP04cpfReport()
Dim links As Variant
OriginalFileName = Application.ActiveWorkbook.Name
NewFileName = Application.GetSaveAsFilename("SP CPF 04", "Microsoft Excel
(*.xls), *.xls")
If NewFileName = "False" Then
MsgBox "Export Canceled"
Exit Sub
End If
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Name = "SP CPF 04"
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AP$54"
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
Range("A1").Select
' Define variable as an Excel link type.
links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLi nks)
' Break the first link in the active workbook.
ActiveWorkbook.BreakLink _
Name:=links(1), _
Type:=xlLinkTypeExcelLinks
'sets print range
Sheets("SP CPF 04").PageSetup.LeftMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.RightMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.TopMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.BottomMargin =
Application.InchesToPoints(0.5)
Sheets("SP CPF 04").PageSetup.CenterHorizontally = True
Sheets("SP CPF 04").PageSetup.Zoom = 90
Sheets("SP CPF 04").Range("A54") = "Exported from Asphalt Plant
Worksheet"
Sheets("SP CPF 04").Protect password:="xxxx"
ActiveWorkbook.SaveAs Filename:=NewFileName _
, FileFormat:=xlNormal, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub

just to add some clean up (so the sheets don't say grouped)

Dim bk as Workbook
Dim sh as Worksheet, bReplace as Boolean
Dim sh1 as Worksheet
set sh1 = Activesheet
bReplace = True
for each sh in Worksheets
if sh.visible = True then
sh.Select Replace:=bReplace
bReplace = False
end if
Next
activewindows.SelectedSheet.copy
set bk = Activeworkbook
worksheets(1).Select
sh1.Parent.Activate
sh1.Select
bk.Activate

--
Regards,
Tom Ogilvy


"Tom Ogilvy" wrote:

Dim sh as Worksheet, bReplace as Boolean
bReplace = True
for each sh in Worksheets
if sh.visible = True then
sh.Select Replace:=bReplace
bReplace = False
end if
Next
activewindows.SelectedSheet.copy

--
Regards,
Tom Ogilvy



"Clay" wrote:

I need to be able to copy all sheets that are visible (could be 2 sheets to 5
sheets) to a new workbook and give the user the ability to save the file
before closing it. I currently have code to extract one sheet at a time...
but I can't figure out how to put all of them into one workbook. Here's the
code (don't make fun, I've been using VBA for about 6 months) for extracting
a single worksheet. There are links that need to be broken and the print
range needs to be set as well...
Thanks in advance!


Sub ExportSP04cpfReport()
Dim links As Variant
OriginalFileName = Application.ActiveWorkbook.Name
NewFileName = Application.GetSaveAsFilename("SP CPF 04", "Microsoft Excel
(*.xls), *.xls")
If NewFileName = "False" Then
MsgBox "Export Canceled"
Exit Sub
End If
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Name = "SP CPF 04"
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AP$54"
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
Range("A1").Select
' Define variable as an Excel link type.
links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLi nks)
' Break the first link in the active workbook.
ActiveWorkbook.BreakLink _
Name:=links(1), _
Type:=xlLinkTypeExcelLinks
'sets print range
Sheets("SP CPF 04").PageSetup.LeftMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.RightMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.TopMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.BottomMargin =
Application.InchesToPoints(0.5)
Sheets("SP CPF 04").PageSetup.CenterHorizontally = True
Sheets("SP CPF 04").PageSetup.Zoom = 90
Sheets("SP CPF 04").Range("A54") = "Exported from Asphalt Plant
Worksheet"
Sheets("SP CPF 04").Protect password:="xxxx"
ActiveWorkbook.SaveAs Filename:=NewFileName _
, FileFormat:=xlNormal, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub

Thanks!

"Tom Ogilvy" wrote:

just to add some clean up (so the sheets don't say grouped)

Dim bk as Workbook
Dim sh as Worksheet, bReplace as Boolean
Dim sh1 as Worksheet
set sh1 = Activesheet
bReplace = True
for each sh in Worksheets
if sh.visible = True then
sh.Select Replace:=bReplace
bReplace = False
end if
Next
activewindows.SelectedSheet.copy
set bk = Activeworkbook
worksheets(1).Select
sh1.Parent.Activate
sh1.Select
bk.Activate

--
Regards,
Tom Ogilvy


"Tom Ogilvy" wrote:

Dim sh as Worksheet, bReplace as Boolean
bReplace = True
for each sh in Worksheets
if sh.visible = True then
sh.Select Replace:=bReplace
bReplace = False
end if
Next
activewindows.SelectedSheet.copy

--
Regards,
Tom Ogilvy



"Clay" wrote:

I need to be able to copy all sheets that are visible (could be 2 sheets to 5
sheets) to a new workbook and give the user the ability to save the file
before closing it. I currently have code to extract one sheet at a time...
but I can't figure out how to put all of them into one workbook. Here's the
code (don't make fun, I've been using VBA for about 6 months) for extracting
a single worksheet. There are links that need to be broken and the print
range needs to be set as well...
Thanks in advance!


Sub ExportSP04cpfReport()
Dim links As Variant
OriginalFileName = Application.ActiveWorkbook.Name
NewFileName = Application.GetSaveAsFilename("SP CPF 04", "Microsoft Excel
(*.xls), *.xls")
If NewFileName = "False" Then
MsgBox "Export Canceled"
Exit Sub
End If
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Name = "SP CPF 04"
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AP$54"
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
Range("A1").Select
' Define variable as an Excel link type.
links = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLi nks)
' Break the first link in the active workbook.
ActiveWorkbook.BreakLink _
Name:=links(1), _
Type:=xlLinkTypeExcelLinks
'sets print range
Sheets("SP CPF 04").PageSetup.LeftMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.RightMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.TopMargin =
Application.InchesToPoints(0.25)
Sheets("SP CPF 04").PageSetup.BottomMargin =
Application.InchesToPoints(0.5)
Sheets("SP CPF 04").PageSetup.CenterHorizontally = True
Sheets("SP CPF 04").PageSetup.Zoom = 90
Sheets("SP CPF 04").Range("A54") = "Exported from Asphalt Plant
Worksheet"
Sheets("SP CPF 04").Protect password:="xxxx"
ActiveWorkbook.SaveAs Filename:=NewFileName _
, FileFormat:=xlNormal, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub