Copiar encabezado de hoja llamada Resumen a hoja nueva
Tengo la siguiente macro que genera una hoja nueva con información si la hoja no existe sino copia a la última fila vacía. Cómo hacer para que pegue en la primer fila de la hoja nueva el encabezado de la hoja llamada Resumen, va desde B2:AB2
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim max As Long, cont As Long, lr As Long
Dim Nombre As String
'
Set sh = Sheets("Hoja2") '<---Nombre de tu hoja origen
'Crear palntilla de jugador
'Máximo de filas a considerar
max = 1
'
'Recorrer las filas de la columna A desde 1 hasta Max
For cont = 1 To max
'Colocar el contenido de la celda en la variable Nombre
Nombre = sh.Cells(cont, 1).Value
'Si el Nombre es diferente a vacío, entonces crear la nueva hoja
If Nombre <> "" Then
'Verifica si existe la hoja
If Evaluate("ISREF('" & Nombre & "'!A1)") Then
lr = Sheets(Nombre).Range("B" & Rows.Count).End(3).Row + 1
Else
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Nombre
lr = 2
End If
With Sheets(Nombre)
.Range("B" & lr).Value = sh.Range("D8").Value
.Range("C" & lr).Value = sh.Range("D9").Value
.Range("D" & lr).Value = sh.Range("D10").Value
End With
End If
Next cont
End Sub
1 Respuesta
Respuesta de Dante Amor
2
Te paso la macro actualizada:
Private Sub CommandButton1_Click()
'Por Dante Amor
'
Dim sh As Worksheet
Dim max As Long, cont As Long, lr As Long
Dim Nombre As String
'
Set sh = Sheets("Hoja2") '<---Nombre de tu hoja origen
'Crear palntilla de jugador
'Máximo de filas a considerar
max = 1
'
'Recorrer las filas de la columna A desde 1 hasta Max
For cont = 1 To max
'Colocar el contenido de la celda en la variable Nombre
Nombre = sh.Cells(cont, 1).Value
'Si el Nombre es diferente a vacío, entonces crear la nueva hoja
If Nombre <> "" Then
'Verifica si existe la hoja
If Evaluate("ISREF('" & Nombre & "'!A1)") Then
lr = Sheets(Nombre).Range("B" & Rows.Count).End(3).Row + 1
Else
'crea la nueva hoja
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Nombre
'copia encabezado de la hoja resumen y lo pega en la fila 1 de la nueva hoja
Sheets("Resumen").Range("2:2").Copy Sheets(Nombre).Range("A1")
lr = 2
End If
With Sheets(Nombre)
.Range("B" & lr).Value = sh.Range("D8").Value
.Range("C" & lr).Value = sh.Range("D9").Value
.Range("D" & lr).Value = sh.Range("D10").Value
End With
End If
Next cont
End SubNota: Avísame cualquier duda sobre el código.
