Abonos para Pagos de Personal
A los prestigiosos integrantes de este foro, en esta ocasión recurro a uds, para solicitar su ayuda en como modificar la macro, el cual permita guardar el archivo resultado con la extensión .xls, ya que con esta macro lo genera con la extensión .xlsm, siendo una copia exactamente al original con la diferencia que en el archivo fuente son barrados los datos ingresados, por lo que necesito es que al guardar el archivo resultado elimine las hojas BASES DE DATOS y Hoja1 quedando únicamente la Hoja2 (el cual contiene formula que son transportador de la Hoja1 - resaltado de color celeste) y solo debe quedar como valores.
Sub guardar24072015()
Nombre = ActiveWorkbook.Name
Carpetaa = ActiveWorkbook.Path
filaa = Carpetaa & "\" & Nombre
Nombrar = MsgBox("usar el archivo por default", vbYesNo + vbDefaultButton2, "AVISO")
If Nombrar = vbYes Then
filab = Carpetaa & "\" & "plantilla electronica1"
Else
Titulo = InputBox("¿Como se va a llamar el archivo?", "AVISO")
If Titulo = "" Then
Exit Sub
Else
filab = Carpetaa & "\" & UCase(Titulo) & ".xlsm"
End If
End If
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=filab, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
xNombre = ActiveWorkbook.Name
Workbooks.Open (filaa)
Sheets("Hoja1").Range("C2:C50").ClearContents
Sheets("Hoja1").Range("G2:G50").ClearContents
Workbooks("ESTRUCTURA DE ABONOS.xlsm").Save
Sheets("Hoja1").Select
Range("C2").Select
Workbooks(xNombre).Close savechanges = True
Sheets("Hoja1").Range(Cells(2, 1), Cells(lastRow, 50)).ClearContents
End Sub
1 Respuesta
Te anexo la macro actualizada para guardar como xls
Sub Guardar_Hoja()
'Por.Dante Amor
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = Sheets("Hoja2")
nombre = Left(l1.Name, InStrRev(l1.Name, ".") - 1)
'
Carpetaa = ThisWorkbook.Path
filaa = Carpetaa & "\" & nombre
Nombrar = MsgBox("usar el archivo por default", vbYesNo + vbDefaultButton2, "AVISO")
If Nombrar = vbYes Then
filab = Carpetaa & "\" & "plantilla electronica1.xls"
Else
Titulo = InputBox("¿Como se va a llamar el archivo?", "AVISO")
If Titulo = "" Then
Exit Sub
Else
filab = Carpetaa & "\" & UCase(Titulo) & ".xls"
End If
End If
'
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
'
h1.Cells.Copy
h2.Range("A1").PasteSpecial Paste:=xlValues
h2.Range("A1").PasteSpecial Paste:=xlPasteFormats
'
l2.SaveAs Filename:=filab & ".xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
l2.Close
'
MsgBox "Archivo guardado"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Buenas noches amigo Dante, agradeciendo siempre tu apoyo incondicional, la macro quedo bien y solo me quedo con una inquietud, es que en la macro original, luego de grabar me permite borrar los datos ingresados con la rutina siguiente, espero tus comentarios amigo.
Sheets("Hoja1").Range("C2:C50").ClearContents
Sheets("Hoja1").Range("G2:G50").ClearContentsPuedes poner esas líneas después de la línea:
L2. Close
.
'S aludos. Dante Amor. Recuerda valorar la respuesta
.
