Consulting

Results 1 to 5 of 5

Thread: Solved: Copy Worksheet to new Workbook

  1. #1
    VBAX Tutor jo15765's Avatar
    Joined
    Oct 2011
    Posts
    281
    Location

    Solved: Copy Worksheet to new Workbook

    I have this code below that will copy all worksheets to a new workbook. What I am now needing is to only copy the 2nd tab of a worksheet to a new workbook, and it is turning out to be much more difficult of a task than I originally anticipated. Can someone take a look at my code, and point out my error:
    [VBA]
    Dim Varbooks As Variant
    Dim wb As Workbook, wbFinal As Workbook
    Dim i As Long
    Const Path As String = "File Path Goes Here"

    Varbooks = Array("Name of Workbook Goes Here")

    Set wbFinal = ActiveWorkbook
    Application.EnableEvents = False
    For i = LBound(Varbooks, 1) To UBound(Varbooks, 1)
    Set wb = Workbooks.Open(Path & Varbooks(i))
    wb.Worksheets.Copy wbFinal.Worksheets(1)
    wb.Close False
    Next
    Application.EnableEvents = True
    [/VBA]

  2. #2
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    If you only want to copy one sheet, then it would be:
    [vba]wb.Worksheets(2).Copy wbFinal.Worksheets(1)[/vba]
    Be as you wish to seem

  3. #3
    VBAX Mentor
    Joined
    Apr 2009
    Location
    Kingsbury
    Posts
    423
    Location
    Try this
    [VBA]
    Option Explicit
    Sub SaveSheet1()
    Dim NewName As String
    Dim wb As Workbook
    Dim nm As Name
    Dim ws As Worksheet
    Dim wksCopy As Worksheet
    Dim strFullname As String
    If Not MsgBox("Copy specific sheets to a new workbook" & vbCr & _
    "New Sheets Will Be Pasted As Values Only" _
    , vbYesNo, "NewCopy") = vbYes Then Exit Sub

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    '// Copy specific sheets as in the named Array
    On Error GoTo ErrCatcher
    Sheets(Array("Sheet1")).Copy
    On Error GoTo 0

    Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
    ws.UsedRange.Value = ws.UsedRange.Value
    Next ws

    '//Display Input box to name new file
    NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

    '//Save it with the NewName and in the same directory as original
    wb.SaveAs ThisWorkbook.Path & "\" & NewName & ".xls"



    wb.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    On Error Resume Next
    ' Kill strFullname
    On Error GoTo 0
    Exit Sub



    ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
    End Sub

    [/VBA]

  4. #4
    VBAX Tutor jo15765's Avatar
    Joined
    Oct 2011
    Posts
    281
    Location
    Rob Each sheet is in a seperate workbook, It looks to me like your code is loooking for them in the same workbook. (And it looks like I forgot to put that in my original post)


    Aflatoon how could I add a line in there that will automatically save the workbook for me? I tried adding in..
    [VBA]
    ' With wb
    ' .SaveAs Filename:="Location" & "FileName"
    ' End With
    [/VBA]

    But that threw a crazy VB error?
    Last edited by jo15765; 12-09-2011 at 07:49 AM.

  5. #5
    VBAX Tutor jo15765's Avatar
    Joined
    Oct 2011
    Posts
    281
    Location
    Disregard my previous post, I modified the save code to:
    [VBA]
    Set wb = ActiveWorkbook
    wb.SaveAs Filename:="Location" & "Filename"
    wb.Close
    [/VBA]

    And it saved no trouble....As always thank you for the support!

Posting Permissions

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