Consulting

Results 1 to 11 of 11

Thread: Solved: Function to copy sheet to new file

  1. #1
    VBAX Regular
    Joined
    Apr 2012
    Posts
    9
    Location

    Solved: Function to copy sheet to new file

    Hi everyone!

    I'm not a programmer, but I'm trying to create a function that copy a range of cells from a sheet in a workbook to a new workbook as values, but with the same cells format.
    In the same function, I would like to have the option of saving the sheet in a complete new workbook, or open an existing one, and add the new sheet.
    Is this possible to do in VBA???
    Here's the code I've done so far, but it only saves the sheet into a new file:
    [vba]
    Sub Save_CostSheet()
    Dim NewFileName As String
    Dim NewTitle As String
    Dim SheetName As String
    Dim CurrentBook As Workbook
    Dim CurrentSheet As Worksheet
    'Name of the cost sheet title.
    NewTitle = InputBox("Please Specify the Title for this Cost Sheet", "New Cost Sheet")
    If NewTitle = "False" Or NewTitle = "" Then
    Exit Sub
    End If
    'Getting the name of the new file.
    NewFileName = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Save As")
    If NewFileName = "False" Or NewTitle = "" Then
    Exit Sub
    End If
    'Saving sheet name and copy.
    SheetName = ActiveSheet.Name
    Sheets(SheetName).Copy
    'Saving the new file with selected sheet.
    If LCase$(Right$(NewFileName, 4)) <> ".xls" Then
    NewFileName = NewFileName & ".xls"
    End If
    Set CurrentBook = ActiveWorkbook
    With CurrentBook
    If NewFileName <> "False" Then
    Set CurrentSheet = ActiveSheet
    With CurrentSheet
    .Range("A1").Value = NewTitle
    End With
    .SaveAs NewFileName
    .Close
    Else
    .Close False
    Exit Sub
    End If
    End With
    End Sub
    [/vba]

    This code as also a problem with the file created. Everytime I open the new file, a message popup saying that the file is in a different format than specified by the file extension. Does anyone knows how to avoid this?

    Thanks by the help!!!

  2. #2
    VBAX Mentor Teeroy's Avatar
    Joined
    Apr 2012
    Location
    Sydney, Australia
    Posts
    414
    Location
    I think this is what you wanted. I've simplified your code in a few areas, especially where the new workbook is opened. Basically a new blank workbook is added and the user can choose their name when they save it.

    [vba]
    Sub Save_CostSheet()
    Dim i As Integer
    Dim numberOpenWorkbooks As Integer
    Dim choose As String
    Dim NewFileName As String
    Dim NewTitle As String
    Dim SheetName As String
    Dim CurrentBook As Workbook
    Dim CurrentSheet As Worksheet
    Dim NewBook As Workbook
    Dim ExistingWB As String


    'Name of the cost sheet title.
    NewTitle = InputBox("Please Specify the Title for this Cost Sheet", "New Cost Sheet")
    If NewTitle = "False" Or NewTitle = "" Then
    Exit Sub
    End If
    'Set the location of the starting point

    Set CurrentBook = ActiveWorkbook
    Set CurrentSheet = ActiveSheet

    'count original number of open workbooks
    numberOpenWorkbooks = Application.Workbooks.Count


    'work out whether to append to existing Workbook or create new one
    repeat_question:
    choose = InputBox("Do you want to open an existing Workbook <1> or save to a new Workbook <2>", "Select location for new (copied) sheet")
    Select Case Val(choose):
    Case 0:
    Exit Sub
    Case 1:
    ExistingWB = Application.GetOpenFilename( _
    FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
    Workbooks.Open Filename:=ExistingWB
    Case 2:
    Application.Workbooks.Add
    Case Else:
    GoTo repeat_question
    End Select
    'set the newBook as the latest member of the Workbooks collection
    Set NewBook = Application.Workbooks(numberOpenWorkbooks + 1)
    'Copy the currect sheet before the first sheet of the newly opened or added workbook
    CurrentSheet.Copy Before:=NewBook.Sheets(1)

    'Set the new Title of the new sheet
    NewBook.Sheets(1).Range("A1").Value = NewTitle

    End Sub

    [/vba]

  3. #3
    VBAX Regular
    Joined
    Apr 2012
    Posts
    9
    Location
    Hi Teeroy,

    Thanks for your help! Definitly, your code is better than mine, just added it the option to ask for the name of the new file.
    And it's here where I stil struggle with a problem. After the function run and create the new workbook with my sheet on it, I save the file and close it. Then, if I try to open the file, I receive a message saying that the file format is different than the specified by the file extension.
    Do you know why this happen, and how to resolve it?

    Many thanks!

  4. #4
    VBAX Mentor Teeroy's Avatar
    Joined
    Apr 2012
    Location
    Sydney, Australia
    Posts
    414
    Location
    Hi Sersan,

    I didn't get that error testing with both Excel 2003 and 2010.

    Are you running Excel 2007 or 2010? If so this error is because the new format extension is .xlsx (or .xlsm if macros are included) not .xls. If you allow the user to save you won't get that error. You may also try not having a file extension on the FileName variable as I think the correct type will be added by default (I'm not able to test this 'til later).

    If the above doesn't work please post your new code to see whether the changes you've made have affected the running.

  5. #5
    VBAX Regular
    Joined
    Apr 2012
    Posts
    9
    Location
    Hi,
    Sorry for late reply. I've try to make the function to save always as xlsx file, but stil not able to do that.
    One small note, the original file extension is xls, don't know if it makes any difference.
    This is my current code:
    [vba]
    Sub Save_CostSheet()

    Dim csFileName As String
    Dim csTitle As String
    Dim opChoose As String
    Dim wbExisting As String
    Dim wbOpenNumber As Integer
    Dim wbCurrent As Workbook
    Dim wbNew As Workbook
    Dim stCurrent As Worksheet

    'Name of the cost sheet title.
    csTitle = InputBox("Please Specify the Title for this Cost Sheet", "New Cost Sheet")
    If csTitle = "False" Or csTitle = "" Then
    Exit Sub
    End If

    'Set the location of the starting point.
    Set wbCurrent = ActiveWorkbook
    Set stCurrent = ActiveSheet

    'Count original number of open workbooks.
    wbOpenNumber = Application.Workbooks.Count

    'Choose to open file or to create a new one.
    Repeat_Question:
    opChoose = InputBox("Do you Want to Open an Existing File <1> or to Save to a New File <2>", "Select Option")
    If opChoose = "False" Or opChoose = "" Then
    Exit Sub
    End If
    Select Case Val(opChoose):
    Case 0:
    Exit Sub
    Case 1:
    wbExisting = Application.GetOpenFilename(filefilter:="Microsoft Excel Workbooks, *.xlsx", Title:="Open Workbook")
    If wbExisting = "False" Or wbExisting = "" Then
    Exit Sub
    End If
    Workbooks.Open Filename:=wbExisting
    Case 2:
    csFileName = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbooks, *.xlsx", Title:="Save Workbook As")
    If csFileName = "False" Or csFileName = "" Then
    Exit Sub
    End If
    Application.Workbooks.Add
    ActiveWorkbook.SaveAs csFileName
    Case Else:
    GoTo Repeat_Question
    End Select

    'Set the new sheet as the latest member of the workbook.
    Set wbNew = Application.Workbooks(wbOpenNumber + 1)

    'Copy the new sheet before the first sheet of the workbook opened or created.
    stCurrent.Copy Before:=wbNew.Sheets(1)

    'Set the title of the new sheet.
    wbNew.Sheets(1).Range("A1").Value = csTitle
    End Sub
    [/vba]

  6. #6
    VBAX Expert Tinbendr's Avatar
    Joined
    Jun 2005
    Location
    North Central Mississippi (The Pines)
    Posts
    993
    Location
    Try
    [VBA]ActiveWorkbook.SaveAs csFileName, FileFormat:=xlWorkbookDefault[/VBA]

    David


  7. #7
    VBAX Mentor Teeroy's Avatar
    Joined
    Apr 2012
    Location
    Sydney, Australia
    Posts
    414
    Location
    I think Tinbendr's got your fix but have a look at this link for some more information if you need it.

    http://www.rondebruin.nl/saveas.htm
    _________________________________________________________________________
    "In theory there is no difference between theory and practice. In practice there is." - Chuck Reid

    Any day you learn something new is a day not wasted.

  8. #8
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    To save a worksheet as a new workbook, using the same extension and the same fileformat:

    [vba]Sub snb()
    With ThisWorkbook
    .Sheets("Sheet1").Copy
    ActiveWorkbook.SaveAs Replace(.FullName, ".", "_001."), .FileFormat
    ActiveWorkbook.close
    End With
    End Sub[/vba]

    If you want all formulae being removed:

    [vba]Sub snb()
    With ThisWorkbook
    .Sheets("Sheet1").Copy
    ActiveWorkbook.sheets(1).cells.value=ActiveWorkbook.Sheets(1).Cells.value
    ActiveWorkbook.SaveAs Replace(.FullName, ".", "_001."), .FileFormat
    ActiveWorkbook.close
    End With
    End Sub[/vba]

  9. #9
    VBAX Regular
    Joined
    Apr 2012
    Posts
    9
    Location
    Thanks guys for your help!
    I think that now, I can finish my project...

  10. #10
    VBAX Regular
    Joined
    Apr 2012
    Posts
    9
    Location
    Guys, after all, I still need your help!!!

    Now, I need to make the sheet in the new workbook only as values. I know how to copy and paste as values a selected range, but is it possible to select all sheet, copy it and paste it as values?

    Then, I'm trying to delete the sheets in the new workbook "Sheet1, Sheet2 and Sheet3". It's easy to delete it, but how to manage the error I found when I try to delete, and the sheet doesn't exists anymore?

    Finaly, what's the best way to delete selected rows and columns?

    Thanks mates!

  11. #11
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Please start a new thread in the forum
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

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