Macro que copie encabezado de una hoja a otra

Sigo en la novatez con vba pero poco a poco le agarro el gusto a este lenguaje, sin embargo sigo topándome con cuestiones como ésta que les platico:
Tengo un libro, donde en cada hoja que tiene algunas filas coloreadas, bien, estoy trabajando con una macro que de cada hoja crea una hoja donde copia solo las filas coloreadas, hasta aquí, perfecto, ahora bien, mi problema se centra en que las hojas origen(de la que se sacan filas coloreadas) tiene un encabezado (es el mismo para todas las hojas) que va de A1:05, mismo que la macro no copia en las hojas creadas y es imprescindible que también sea copiado por encima de las filas coloreadas, les anexo la macro con la que estoy trabajando y ojalá me puedan ayudar u orientar en donde podría modificarle para que se lleve a cabo este proceso. Desde ya, gracias!.

Sub copiafila()
For Each sh In ActiveWorkbook.Sheets
'selecciono la hoja
sh.Select
'puedo omitir alguna hoja
If sh.Name <> "Management Team" Then
Application.ScreenUpdating = False
On Error Resume Next
Set h1 = ActiveSheet
Set h2 = Sheets.Add

h1.Select
ini = "A"
fin = "O"
For i = 2 To h1.Range(ini & Rows.Count).End(xlUp).Row
si = 0
For j = 1 To Range(fin & 1).Column
Cells(i, j).Select
If Cells(i, j).Interior.ColorIndex = 6 Or Cells(i, j).Interior.ColorIndex = 27 Then
si = 1
Else
si = 0
End If
Next
If si = 1 Then
Range(ini & i & ":" & fin & i).Select
h1.Range(ini & i & ":" & fin & i).Copy h2.Range(ini & h2.Range(ini & Rows.Count).End(xlUp).Row + 1)
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next
End If
'pasa a la hoja siguiente
Next sh
Application.ScreenUpdating = True
End Sub

1 respuesta

Respuesta
1

Elizabeth,

Lo que haría yo si fuera tu seria lo siguiente, crear una macro que crees hojas al presionar un botón que haga todo lo que quieras .

sub nueva_hoja()

Dim nom_hoja As String
Application.ScreenUpdating = False
nom_hoja = InputBox("Ingrese El nombre de la Nueva hoja", "Nueva Hoja")

If StrPtr(nom_hoja) <> 0 And nom_hoja <> "" Then

Worksheets.Add.Name = nom_hoja 'crea una hoja con el nombre que nos dieron

Range("A1").Value = "Lo que muestra en A1"

Range("A2").Value = "Lo que muestra en A2"

Range("A3").Value = "Lo que muestra en A3"

Range("A4").Value = "Lo que muestra en A4"

Range("A5").Value = "Lo que muestra en A5"

end if

end sub

'Ojala te halla servido, Cualquier cosa sigue atenta a este tema y responderé

Elizabeth, una aclaración

'Este código lo que hace es verificar que en el inputbox si ponen cancel, la macro no se 'cae :), saludos

StrPtr(nom_hoja) <> 0

Nicolás Hernandez

Agradezco infinitamente tu ayuda, aunque esta vez la respuesta no me ayude en mi problema, pues lo que busco es modificar esta macro (que cumple y de maravilla su función) para que copie en primer lugar el rango A1:05 y después las filas que la macro ya corta y pega en la hoja nueva pero lo hace desde A2(lo cual no deja espacio para el encabezado), o sea la nueva hoja debería ir: de A1:05 = rango encabezado(que copia de la hoja origen, donde se copian las filas coloreadas) después a partir de A6 las filas que la macro ya copia(las filas coloreadas), espero darme a entender. Ojalá me puedas ayudar! soy novata y volver a hacer la macro desde un inicio como me propones me resulta más complicado :( disculpa mis limitaciones!.

Te copiare un link en donde encontraras las diferentes maneras de copiar celdas.

http://exceltotal.com/como-copiar-y-pegar-celdas-con-vba/

sub copiar()

dim celda as string

'revisa celda por celda

for i=1 to 250 then

celda=

next

end sub

Te copiare un link en donde encontraras las diferentes maneras de copiar celdas.

http://exceltotal.com/como-copiar-y-pegar-celdas-con-vba/

Igual te haré un ejemplo de la función que necesitas

Colores RGB ( RED, GREEN, BLUE) (BUSCA COLUMNAS EN LA PAGINA)

http://dmcritchie.mvps.org/excel/colors.htm

sub copiar()

dim celda as string

'revisa celda por celda

for i=1 to 250 then

celda= "A"& i

'El color que busca es rojo claro, averigua los colores que estas buscando en RGB

if range(celda)..Interior.Color = RGB(255, 199, 206)

'(MÉTODO QUE ESTIMES CONVENIENTE PARA COPIAR)

next

end sub

Esta macro, te servirá para el movimiento de datos según color, analízalo y se un poco mas claro en lo que necesitas . Me encantas las macros y ayudar a la gente solo que necesito saber exactamente lo que necesitas

Sub recorre()
Application.ScreenUpdating = False
For i = 2 To 1001
If Range("B" & i).Value = "Perro" Then
Range("C" & i).Value = "Se Encontró Un Perro"
Range("C" & i).Interior.Color = RGB(0, 255, 0)
Else
Range("C" & i).Value = "No Se Encontró Un Perro"
Range("C" & i).Interior.Color = RGB(255, 0, 0)
End If
Next
Application.ScreenUpdating = True
End Sub
Sub copiar_si()
Dim copiado As String
Dim contador As Integer
contador = 1
Application.ScreenUpdating = False
For i = 2 To 1001
If Range("C" & i).Interior.Color = RGB(0, 255, 0) Then
contador = contador + 1
Range("D" & contador).Value = Range("A" & i).Value
End If
Next
MsgBox ("Se econtraron " & contador - 1 & " Perros")
Application.ScreenUpdating = True
End Sub

Ya lo resolví con mis propios métodos! Gracias de cualquier forma. Lindo día.

Primeramente gracias, aunque siento que realmente no entendiste mi problema central, así que tuve que investigar y a prueba y error lo he solucionado y de paso he aprendido mucho más y espero ser un día experta como vos! Lindo día!.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas