Cómo sería el macro para que cree una hoja, copie el formulario principal y a esa hoja nueva le asigne un consecutivo?
Necesito hacer un libro donde en la pagina principal hay un formulario establecido, ya cree un macro que escribe un consecutivo, pero necesito que ese formulario con la info escrita se copie en una hoja nueva y que esa hoja tenga por nombre el consecutivo del formulario...
2 Respuestas
Como podrás ver no soy muy experto...le doy el botón de grabar macro y lo que hago es muy sencillo...este seria el formulario (el consecutivo seria en la imagen lo que dice CON 1
Sub imprynuevo()
'
' imprynuevo Macro
'
'
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Range("A9:P13").Select
Selection.ClearContents
Range("P2").Select
Selection.Copy
Range("P1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A9").Select
End Sub
H o l a:
Te anexo la macro actualizada, pero antes deberás cambiar el formato de tu formulario, pon en la celda P2 la palabra "CON" y en la celda Q2 vamos a poner el consecutivo:
De esa forma, con la macro, podremos aumentar el consecutivo en 1.
La macro, imprime, te crea la nueva hoja, le cambia el nombre ala nueva hoja con consecutivo, y por último, incrementa el consecutivo en la celda Q2.
Sub imprynuevo()
'Act.Por.Dante Amor
' imprynuevo Macro
Application.ScreenUpdating = False
Set h = ActiveSheet
h.PrintOut Copies:=1, Collate:=True, ignorePrintAreas:=False
nombre = h.[P2] & " " & h.[Q2]
h.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nombre
h.Select
h.Range("A9:P13").ClearContents
h.[Q2] = h.[Q2] + 1
Range("A9").Select
Application.ScreenUpdating = True
MsgBox "Hoja impresa y creada"
End Sub
{"lat":22.155151,"lng":-100.9639331}Te dejo esté código espero te sea de utilidad.
Sub CreaHojas(ByVal sNombre As String)
On Error GoTo Err_CreaHojas
Sheets.Add After:=ActiveSheet
Sheets(Sheets.Count).Select
ActiveSheet.Name = sNombre
'La asignación de datos la harías en las celdas de la nueva hoja
'range("A1")=dato1
Exit_CreaHojas:
Exit Sub
Err_CreaHojas:
MsgBox "Se generó un excepción " & Err.Number & " - " & Err.Description
Resume Exit_CreaHojas
End Sub