PDA

View Full Version : Copy Worksheets to a new Workbook



plawrenz
06-15-2010, 11:50 AM
I am trying to copy all worksheets in a workbook to a new workbook. The number of sheets is different everytime so I used a for loop but it is saving each sheet to a separate book. I want them all in 1 new workbook and saving it using the sFileName. I can't simpliy save as since I don't want the macro in the new workbook! please help!


Sub SaveToNew()
Dim NewName As String
Dim nm As Name
Dim ws As Workbook
Dim sFileName As String
Dim x As Integer

With Application
.StatusBar = ""
.Cursor = xlDefault


sFileName = "\\ho\dfs01\WORK\Investments\TEST_Appls\Projects\UnityQueries\MFA (file://\\ho\dfs01\WORK\Investments\TEST_Appls\Projects\UnityQueries\MFA) - Unity Sector Equities Report - " & _
Format(Date, "yyyy-mm-dd") & " " & Format(Time, "hh.mm.ss ampm") & ".xlsx"
For x = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(x).Copy _
' After:=??????????? I want the sheets to goto sFileName
'Puts all copies after the last existing sheet.
Next
If MsgBox("Save this file as: " & vbCr & _
sFileName, vbQuestion + vbYesNo + vbDefaultButton1, "Please Confirm") = vbYes Then

ActiveWorkbook.SaveAs (sFileName)
End If
.ScreenUpdating = True
Exit Sub
End With
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub

Bob Phillips
06-15-2010, 12:24 PM
Sub SaveToNew()
Dim NewName As String
Dim nm As Name
Dim ws As Workbook
Dim sFileName As String
Dim x As Long

With Application

.StatusBar = ""
.Cursor = xlDefault
End With

With ActiveWorkbook

sFileName = "\\ho\dfs01\WORK\Investments\TEST_Appls\Projects\UnityQueries\MFA - Unity Sector Equities Report - " & _
Format(Date, "yyyy-mm-dd") & " " & Format(Time, "hh.mm.ss ampm") & ".xlsx"

.Worksheets.Copy
If MsgBox("Save this file as: " & vbCr & _
sFileName, vbQuestion + vbYesNo + vbDefaultButton1, "Please Confirm") = vbYes Then

ActiveWorkbook.SaveAs (sFileName)
End If

.ScreenUpdating = True
Exit Sub
End With
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub

GTO
06-15-2010, 12:26 PM
oops... answered