Consulting

Results 1 to 3 of 3

Thread: Copy Worksheets to a new Workbook

  1. #1

    Copy Worksheets to a new Workbook

    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!

    [vba]
    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 - 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
    [/vba]
    Last edited by Bob Phillips; 06-15-2010 at 12:25 PM. Reason: Added VBA tags

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    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
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    oops... answered

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •