Macro para guardar archvio

[UW07071997]

Buenos Días:

Alguien me podría ayudar para guardar un archivo completo con una macro, tenía para guardar una hoja pero quiero guardar todo el archivo.

Option Explicit

'

Sub EXCELeINFOGuardarHojaComoArchivoNuevo()

'

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

'

On Error GoTo ErrorHandler

'

VentanasProtegidas = ActiveWorkbook.ProtectWindows

EstructuraProtegida = ActiveWorkbook.ProtectStructure

'

If VentanasProtegidas = True Or EstructuraProtegida = True Then

MsgBox "No se puede ejecutar el comando cuando la estructura del archivo está protegida.", _

vbExclamation, "EXCELeINFO"

Else

'

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

'

ErrorHandler:

MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "EXCELeINFO"

Workbooks(NombreArchivo).Close SaveChanges:=False

'

End Sub