Insertar Hojas según celda
Hola después de mucho tiempo vuelvo a molestarte, te explico:
En una hoja excel (Hoja1)tengo una tabla con los siguienets Datos: "Nombre de Persona" y "Telefono", y en otra hoja excel (Hoja2) tengo un formato; quiero una macro que al ejecutarla me cree tantas hojas como personas tenga la Hoja1, y que estas hojas que se crearon sean una copia exacta del formato de la Hoja2; y ademas de ello que el nombre de cada persona aparezca en la celda A2 (ojo que es una hoja por persona) y el teléfono que aparezca en la celda B2.
Espero puedas ayudarme
Saludos
En una hoja excel (Hoja1)tengo una tabla con los siguienets Datos: "Nombre de Persona" y "Telefono", y en otra hoja excel (Hoja2) tengo un formato; quiero una macro que al ejecutarla me cree tantas hojas como personas tenga la Hoja1, y que estas hojas que se crearon sean una copia exacta del formato de la Hoja2; y ademas de ello que el nombre de cada persona aparezca en la celda A2 (ojo que es una hoja por persona) y el teléfono que aparezca en la celda B2.
Espero puedas ayudarme
Saludos
1 Respuesta
Respuesta de javigo
1
Prueba con esta macro:
Sub creahojas()
'Ir a la primera celda de la tabla
Sheets("Hoja1").Activate
ActiveSheet.Range("A1").Activate
'Inicio del bucle
Do While Not IsEmpty(ActiveCell)
'Copia la Hoja2 al final
Sheets("Hoja2").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Hoja" & Sheets.Count
'Copia y pega la celda de la columna A
Sheets("Hoja1").Activate
ActiveCell.Copy
Sheets(Sheets.Count).Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copia y pega la celda de la columna B
Sheets("Hoja1").Activate
ActiveCell.Offset(0, 1).Copy
Sheets(Sheets.Count).Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Avanza una fila en la tabla
Sheets("Hoja1").Activate
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Creo que es lo que estabas buscando, ya me dices si te funciona o necesita algún retoque.
Sub creahojas()
'Ir a la primera celda de la tabla
Sheets("Hoja1").Activate
ActiveSheet.Range("A1").Activate
'Inicio del bucle
Do While Not IsEmpty(ActiveCell)
'Copia la Hoja2 al final
Sheets("Hoja2").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Hoja" & Sheets.Count
'Copia y pega la celda de la columna A
Sheets("Hoja1").Activate
ActiveCell.Copy
Sheets(Sheets.Count).Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copia y pega la celda de la columna B
Sheets("Hoja1").Activate
ActiveCell.Offset(0, 1).Copy
Sheets(Sheets.Count).Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Avanza una fila en la tabla
Sheets("Hoja1").Activate
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Creo que es lo que estabas buscando, ya me dices si te funciona o necesita algún retoque.
