Necesito Unir dos Macros en Excel, Ayuda..

Quiero unir dos Macros.

La primera: "Macro que Me Pregunta si quiero Imprimir y me Borra los datos de determinadas celdas."

La Segunda: "Macro que me guarda las celdas de la Hoja1 en la Hoja 2 al momento de Imprimir, es como un historial consecutivo."

Tengo una Imagen a la cual le le pondré la Macro.

Necesito Unirlas ya que no me acepta asignarle dos.

MACRO 1:

Sub impresion_factura()
Application.ScreenUpdating = False
Dim respuesta As Integer
'te pregunta si quieres seguir con la macro o salir
respuesta = MsgBox("¿Quieres imprimir?", vbYesNo, "Información importante")
If respuesta = 7 Then
Exit Sub
Else
Sheets("quedan").PrintOut Copies:=1, Collate:=True 'imprime selección
'cambia el nº copies:= 1 por la cantidad de copias que quieras
Range("A49:M49").Select
Selection.Copy
Sheets("histórico").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'xlAll
Sheets("quedan").Select
Application.CutCopyMode = False
Range("C12,F12, K9").Select
Selection.ClearContents
Range("D14,I18").Select
Selection.ClearContents
'incrementa en 1 la celda h4
Sheets("quedan").Range("K7") = Sheets("quedan").Range("K7") + 1
Range("K7").Select
Application.ScreenUpdating = True
'guarda el archivo
ActiveWorkbook.Sabe
End If
End Sub

Macro 2:

Sub Guardar_historico()
With Worksheets("quedan")
Worksheets("histórico").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 5) = _
Array(.Range("I18"), .Range("K7"), .Range("F12"), .Range("K9"), .Range("C12"))
End With
End Sub

1 respuesta

Respuesta
1

He cogidos tus códigos solo debes cambair el orden y listo, espero sea lo que necesitas:

Sub Guardar_historico_Imprime()
With Worksheets("quedan")
Worksheets("histórico").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 5) = _
Array(.Range("I18"), .Range("K7"), .Range("F12"), .Range("K9"), .Range("C12"))
End With
Application.ScreenUpdating = False
Dim respuesta As Integer
'te pregunta si quieres seguir con la macro o salir
respuesta = MsgBox("¿Quieres imprimir?", vbYesNo, "Información importante")
If respuesta = 7 Then
Exit Sub
Else
Sheets("quedan").PrintOut Copies:=1, Collate:=True 'imprime selección
'cambia el nº copies:= 1 por la cantidad de copias que quieras
Range("A49:M49").Select
Selection.Copy
Sheets("histórico").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'xlAll
Sheets("quedan").Select
Application.CutCopyMode = False
Range("C12,F12, K9").Select
Selection.ClearContents
Range("D14,I18").Select
Selection.ClearContents
'incrementa en 1 la celda h4
Sheets("quedan").Range("K7") = Sheets("quedan").Range("K7") + 1
Range("K7").Select
Application.ScreenUpdating = True
'guarda el archivo
ActiveWorkbook.Sabe
End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas