Copy Visible Sheets into one Workbook

[Clay]

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:=xlLinkTypeExcelLinks)
' 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

 

[Tom Ogilvy]

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

 

[Tom Ogilvy]

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

 

[Clay]

Thanks!

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