Save Workbook as New File using VBA in Excel

Q. How Save Workbook as New File? A. Use the following VBA code:

Private Sub SaveWorkbookAsNewFile(NewFileName As String)
    Dim ActSheet As Worksheet
    Dim ActBook As Workbook
    Dim CurrentFile As String
    Dim NewFileType As String
    Dim NewFile As String
 
    Application.ScreenUpdating = False    ' Prevents screen refreshing.

    CurrentFile = ThisWorkbook.FullName
 
    NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _
               "Excel Files 2007 (*.xlsx), *.xlsx," & _
               "All files (*.*), *.*"
 
    NewFile = Application.GetSaveAsFilename( _
        InitialFileName:=NewFileName, _
        fileFilter:=NewFileType)
 
    If NewFile <> "" And NewFile <> "False" Then
        ActiveWorkbook.SaveAs Filename:= NewFile, _
            FileFormat:=xlNormal, _
            Password:="", _
            WriteResPassword:="", _
            ReadOnlyRecommended:=False, _
            CreateBackup:=False
 
        Set ActBook = ActiveWorkbook
        Workbooks.Open CurrentFile
        ActBook.Close
    End If
 
    Application.ScreenUpdating = True
End Sub

How does it work? Let's look inside.

• First, turn off screen updating:

  Application.ScreenUpdating = False

• Store the opened file full path:

  CurrentFile = ThisWorkbook.FullName

• Open window to choose new filename and folder:

• NewFile = Application.GetSaveAsFilename( _
      InitialFileName:=NewFileName, _
      fileFilter:=NewFileType)

• And now save file as new Workbook:

• ActiveWorkbook.SaveAs Filename:= NewFile, _
      FileFormat:=xlNormal, _
      Password:="", _
      WriteResPassword:="", _
      ReadOnlyRecommended:=False, _
      CreateBackup:=False

• We have to close new file and open the origin workbook:

• Set ActBook = ActiveWorkbook
  Workbooks.Open CurrentFile
  ActBook.Close

• and turn on screen updating:

  Application.ScreenUpdating = True

Using Intersection to Create a Range in Excel VBA

Intersect Method returns a Range object that represents the Intersection of Ranges.

Example selects the Intersection of 2 Ranges (A1:D5 and C3:C10). If the Intersection is blank, the example displays a message box:

Private Sub UseIntersection()
    IntersectRanges Range("A1:D5"), Range("C3:C10")
End Sub
 
Private Sub IntersectRanges(range1 As Range, range2 As Range)
    Dim intRange As Range
 
    ' Application.Intersect Method
    Set intRange = Application.Intersect(range1, range2)
 
    If intRange Is Nothing Then
        ' No Intersection
        MsgBox "Ranges Do Not Intersect!"
    Else
        ' Show new Range's address
        MsgBox (intRange.Address)
 
        ' Select new Range
        intRange.Select
    End If
End Sub

Excel VBA: SmartDel Macro

This summary is not available. Please click here to view the post.