Copiar rangos de fila en no seguidos en columna
Si llegasen a existir en cada hoja 2 rangos de filas por ejemplo (E2:U2) y (Z2:¿AX2) cómo se pegarían en la columna?
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro para copiar 2 rangos.
Ya va el ajuste para el nombre de la hoja.
Sub CopiarFilas()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("año 2001") 'hoja1
Set h11 = l1.Sheets("año 2002") 'hoja2
Set l2 = Workbooks("Resultado.xlsx") 'nombre del libro con todo y extensión
Set h2 = l2.Sheets("Columna") 'hoja destino
'
j = 2
h2.Range("A2:B83").ClearContents 'limpia rango destino
For i = Columns("E").Column To Columns("U").Column
If h1.Cells(2, i) <> "" Then
h2.Cells(j, "A") = Right(h1.Name, 4)
h2.Cells(j, "B") = h1.Cells(2, i)
j = j + 1
End If
Next
For i = Columns("Z").Column To Columns("AX").Column
If h1.Cells(2, i) <> "" Then
h2.Cells(j, "A") = Right(h1.Name, 4)
h2.Cells(j, "B") = h1.Cells(2, i)
j = j + 1
End If
Next
For i = Columns("E").Column To Columns("U").Column
If h11.Cells(2, i) <> "" Then
h2.Cells(j, "A") = Right(h11.Name, 4)
h2.Cells(j, "B") = h11.Cells(2, i)
j = j + 1
End If
Next
For i = Columns("Z").Column To Columns("AX").Column
If h11.Cells(2, i) <> "" Then
h2.Cells(j, "A") = Right(h11.Name, 4)
h2.Cells(j, "B") = h11.Cells(2, i)
j = j + 1
End If
Next
MsgBox "Proceso terminado"
End Sub
