Excel Macro to copy specific Tabs into new workbook

Hi,

I need your help in order to copy 2 Tab into a new workbook and then prompt me to save as with a default name that i can modify just a llittle bit before i press save.

My Tabs' name are "Summary" and "Table"
My default file name is "HC - MMMM - YYYY"
mldaigle1Asked:
Who is Participating?
 
SimonConnect With a Mentor Commented:
Yes, immediately under the line
ActiveWorkbook.SaveAs saveName

add line
activeworkbook.close savechanges:=false

Martin may have been having an off day, because although he sensibly suggested a check for an existing copy of the file and provided a function for it, he didn't then call the function from the sub.

Here's an expanded version of the routine, including the function:
Sub CopyToNewWorkBookAndSave()
Dim saveName As Variant
    Sheets(Array("Summary", "tabs")).Copy 'Copy without any further arguments copies to a new workbook and makes it the activeworkbook
    'Prompt for save-as name
ChooseName:
    saveName = Application.GetSaveAsFilename("HC " & Format(Now(), "mmmm") & "-" & Format(Now, "yyyy"), filefilter:="Excel workbooks (*.xls*), *.xls*")
    If saveName <> False Then
        If Not saveName Like ".xlsx" Then saveName = saveName & ".xlsx" Else
        
        If FileExist(CStr(saveName)) Then
            If MsgBox("The file already exists, do you want to overwrite it?", vbexclamtion + vbYesNo) <> vbYes Then
            GoTo ChooseName
            End If
        End If
        Application.DisplayAlerts = False 'turn off alerts to overwrite any existing copy without prompt.
        ActiveWorkbook.SaveAs saveName
        Application.DisplayAlerts = True
        ActiveWorkbook.Close savechanges:=False
    End If
End Sub

Function FileExist(FilePath As String) As Boolean
'Source: http://www.rondebruin
Dim TestStr As String

  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0

'Determine if File exists
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If

End Function

Open in new window

0
 
SimonCommented:
This should do it for you...

Sub CopyToNewWorkBookAndSave()
    Sheets(Array("Summary", "tabs")).Copy 'Copy without any further arguments copies to a new workbook and makes it the activeworkbook
    'Prompt for save-as name
    saveName = Application.GetSaveAsFilename("HC " & Format(Now(), "mmmm") & "-" & Format(Now, "yyyy"))
    If saveName <> False Then
        ActiveWorkbook.SaveAs saveName
    End If
End Sub

Open in new window


Further details on the GetSaveAsFilename options here

Works on Mac & PC.
0
 
Martin LissOlder than dirtCommented:
You should probably add this function
Function FileExist(FilePath As String) As Boolean
'Source: http://www.rondebruin
Dim TestStr As String

'Test File Path (ie "C:\Users\Chris\Desktop\Test\book1.xlsm")
  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0

'Determine if File exists
  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If

End Function

Open in new window

and then modify Simon's code with something like this
Sub CopyToNewWorkBookAndSave()
    Sheets(Array("Summary", "tabs")).Copy 'Copy without any further arguments copies to a new workbook and makes it the activeworkbook
    'Prompt for save-as name
    saveName = Application.GetSaveAsFilename("HC " & Format(Now(), "mmmm") & "-" & Format(Now, "yyyy"))
    If saveName <> False Then
        If vbYes = MsgBox("The file already exists, do you want to overwrite it?", vbexclamtion + vbYesNo) Then
          add modify code here to do what you want
        'ActiveWorkbook.SaveAs saveName
        End If
    End If
End Sub

Open in new window

0
 
mldaigle1Author Commented:
Hi,

I did try both solution and they are working fine.  Thanks,

Would it be possible to add the code to close the temporary workbook after I save the file without asking if i want to save it?  That way, it will bring me back to the master file where i ran the macro?
0
 
mldaigle1Author Commented:
Thanks alot, this is wonderful!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.