Macro para guardar hoja activa como archivo nuevo en Excel

Esta macro que les comparto viene incluída en la reciente versión de EXCELeINFO add-in y en lo personal es una macro que uso mucho.

Ver Video

Cómo funciona

En caso de que la estructura del archivo o ventanas no estén protegidas, pregunta si deseamos guardar la hoja. Si decimos que sí, se procede a copiar la hoja y nos muestra el formulario de Guardar como. La macro permite guardar con las extensiones .xls, .xlsx, .xlsm y .csv.

Código de la macro

Fe de erratas: Se añade un Select Case para detectar correctamente el tipo de archivo a guardar.

Option Explicit
'
Sub EXCELeINFOGuardarHojaComoArchivoNuevo()
'
'Declaramos las variables.
Dim VentanasProtegidas As Boolean
Dim EstructuraProtegida As Boolean
Dim NombreHoja As String
Dim Confirmacion As String
Dim NombreArchivo As String
Dim GuardarComo As Variant
Dim Extension As String
'
'En caso de error.
On Error GoTo ErrorHandler
'
'Validamos si la ventana o la estructura del archivo están protegidos.
VentanasProtegidas = ActiveWorkbook.ProtectWindows
EstructuraProtegida = ActiveWorkbook.ProtectStructure
'
'En caso de estar protegidas mostramos mensaje.
If VentanasProtegidas = True Or EstructuraProtegida = True Then
    MsgBox "No se puede ejecutar el comando cuando la estructura del archivo está protegida.", _
           vbExclamation, "EXCELeINFO"
Else
    '
    'Copiamos la hoja y guardamos.
    NombreHoja = ActiveSheet.Name
    Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _
                          vbQuestion + vbYesNo, "EXCELeINFO")
    Application.ScreenUpdating = False
    If Confirmacion = vbYes Then
        ActiveSheet.Select
        ActiveSheet.Copy
        NombreArchivo = ActiveWorkbook.Name
        GuardarComo = Application.GetSaveAsFilename(InitialFileName:=NombreHoja, _
            fileFilter:="Libro de Excel(*.xlsx), *.xlsx, Libro de Excel habilitado para macros(*.xlsm), *.xlsm, Libro de Excel 97-2003(*.xls), *.xls,CSV (delimitado por comas)(*.csv),*.csv", _
            Title:="EXCELeINFO - guadar hoja activa como archivo nuevo.")
        If GuardarComo = False Then
            Workbooks(NombreArchivo).Close SaveChanges:=False
        Else
            With Application.WorksheetFunction
                Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
            End With

            Select Case Extension
            Case Is = "xlsx"
                ActiveWorkbook.SaveAs GuardarComo
            Case Is = "xlsm"
                ActiveWorkbook.SaveAs GuardarComo, xlOpenXMLWorkbookMacroEnabled
            Case Is = "xls"
                ActiveWorkbook.SaveAs GuardarComo, xlExcel8
            Case Is = "csv"
                ActiveWorkbook.SaveAs GuardarComo, xlCSV
            Case Else
                ActiveWorkbook.SaveAs GuardarComo
            End Select
        End If
    Else
    End If
    '
End If
'
Exit Sub
'
'En caso de error mostramos un mensaje.
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "EXCELeINFO"
Workbooks(NombreArchivo).Close SaveChanges:=False
'
End Sub