Foros del Web » Programación para mayores de 30 ;) » Programación General »

Modificar macro para que copie rango encima

Estas en el tema de Modificar macro para que copie rango encima en el foro de Programación General en Foros del Web. 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 ...
  #1 (permalink)  
Antiguo 06/03/2014, 16:52
 
Fecha de Ingreso: marzo-2014
Mensajes: 1
Antigüedad: 10 años
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

Etiquetas: macros
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 04:12.