Macro para crear hoja, pedir nombre y copiar datos
En Hoja1 tengo una serie de datos y fórmulas. Preciso una macro que al accionarla: cree una nueva hoja, antes de ello me pida el nombre que quiera poner a dicha hoja, copie todos los valores de la Hoja1, los pegue en la nueva hoja creada, y vaya acomodando las hojas que se van creando hacia la derecha de Hoja1.
Aquí intentamos ayudar, no hacer trabajos...
Empieza a hacerlo tu y cuando tengas problemas, nos escribes... De lo contrario, son 100$ hacer esa macro ;-)
1 respuesta más de otro experto
Te anexo la macro.
Cambia en esta línea de la macro "Hoja1" por el nombre de hoja que deseas copiar:
Set h1 = Sheets("Hoja1")Sub Crear_Hoja()
'Por.Dante Amor
'
nombre = InputBox("Escribe el nombre de la nueva hoja : ", "CREAR NUEVA HOJA")
If nombre = "" Then Exit Sub
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(nombre) Then
existe = True
Exit For
End If
Next
If existe Then
MsgBox "El nombre de hoja ya existe"
Exit Sub
End If
'
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
h1.Cells.Copy h2.Range("A1")
h2.Name = nombre
Application.ScreenUpdating = True
'
MsgBox "Hoja creada", vbInformation, "CREAR NUEVA HOJA"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Estimado Dante Amor,
En primer lugar, muchísimas gracias, anda perfecto. Solo quería pedirte si se podría hacer el siguiente cambio: que en la hoja que se crea no se copien las fórmulas que hay en Hoja1, sino los valores de dichas fórmulas.
Te anexo la macro actualizada
Sub Crear_Hoja()
'Por.Dante Amor
'
nombre = InputBox("Escribe el nombre de la nueva hoja : ", "CREAR NUEVA HOJA")
If nombre = "" Then Exit Sub
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(nombre) Then
existe = True
Exit For
End If
Next
If existe Then
MsgBox "El nombre de hoja ya existe"
Exit Sub
End If
'
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
h1.Cells.Copy
h2.Range("A1").PasteSpecial xlValues
h2.Name = nombre
Application.ScreenUpdating = True
'
MsgBox "Hoja creada", vbInformation, "CREAR NUEVA HOJA"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta.
En este mundo del "libre mercado" yo lo haré por 99.99... los siento Gomzky, así es la competencia :p - Abraham Valencia
;-) - Gomzky ..