MEJORAR MACRO AL GRABAR
Publicado: 01 May 2017, 18:27
Buenas días a los miembros de este foro, en esta ocasión quisiera pedir su ayuda en como mejorar la macro, es decir que al grabar el nuevo archivo se grabe con la extensión .xlsx, pero conservando la plantilla en VBA, para lo cual adjunto código, y desde ya agradezco su ayuda.
- Código: Seleccionar todo
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
xnombre = ActiveWorkbook.Name
Workbooks.Open (filaa)
Sheets("LLENADO").Range("B7:G16").ClearContents
Sheets("LLENADO").Range("K7:P16").ClearContents
Sheets("LLENADO").Range("B21:G30").ClearContents
Sheets("LLENADO").Range("K21:P30").ClearContents
Sheets("LLENADO").Range("B35:G44").ClearContents
Sheets("LLENADO").Range("K35:P44").ClearContents
Sheets("LLENADO").Range("B49:G58").ClearContents
Sheets("LLENADO").Range("K49:P58").ClearContents
Sheets("LLENADO").Range("B63:G72").ClearContents
Sheets("LLENADO").Range("K63:P72").ClearContents
Sheets("LLENADO").Range("I7:I16").ClearContents
Sheets("LLENADO").Range("R7:R16").ClearContents
Sheets("LLENADO").Range("I21:I30").ClearContents
Sheets("LLENADO").Range("R21:R30").ClearContents
Sheets("LLENADO").Range("I35:I44").ClearContents
Sheets("LLENADO").Range("R35:R44").ClearContents
Sheets("LLENADO").Range("I49:I58").ClearContents
Sheets("LLENADO").Range("R49:R58").ClearContents
Sheets("LLENADO").Range("I63:I72").ClearContents
Sheets("LLENADO").Range("R63:R72").ClearContents
Workbooks("ESTRUCTURA PLANILLAS.xlsm").Save
Sheets("LLENADO").Select
Range("B7").Select
Workbooks(xnombre).Close savechanges = True
Sheets("LLENADO").Range(Cells(7, 1), Cells(lastRow, 50)).ClearContents
End Sub