Ver Mensaje Individual
  #1 (permalink)  
Antiguo 06/03/2014, 16:52
florchis013
 
Fecha de Ingreso: marzo-2014
Mensajes: 1
Antigüedad: 10 años, 1 mes
Puntos: 0
Pregunta Modificar macro para que copie rango encima

Hola, buenas tardes!
Pues bien, soy notava en el tema macros pero le he agarrado el gusto aunque me topo con situaciones como esta: necesito modificar esta macro (que cumple y de maravilla su función) para que ya modificada 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 rango que comprende el encabezado de las hojas que son reportes), o sea la estructura de 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 puedan ayudar! Les anexo la macro, con la que estoy trabajando y no he sabido en que parte modicarle... desde ya, muchas gracias!!

Sub copiafila()

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

h1.Select
ini = "A"
fin = "O"

For i = 1 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
MsgBox ("ok too" & i)
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