Macro para copiar filas/matrices con espacios entre ellas en función de un valor
A la vista de la imagen adjunta,
Necesito una macro que coja los valores de las COLUMNAS de la T a Z y los pegue en la COLUMNAS de la AE a AK con la particularidad de que existe, en éstas últimas” un salto de 50 filas para cada pilar, es decir, el Pilar 1:00 (columna T) está pegado en el Rango AF5:AK17 y el siguiente hay que pegarlo en el rango AF51:AK63 y así sucesivamente hasta 250 pilares siempre con una diferencia de 46 filas entre las primeras del rango (Fila 5, Fila 51, Fila 97, Fila 143, ...).
Muy importante es que no puedo trabajar con rangos fijos (números) pues mis matrices de datos son de dimensión variable (6 columnas x n filas) pero donde debe ir pegado si que es fijo con los saltos de 46 flas indicados.
Lo estoy intentando con mi pobre VB pero no lo consigo y es muy importante pues me ahorraría cantidades indecentes de horas de trabajo.
H o l a :
Te anexo la macro
Sub CopiarFilas()
'Por.Dante Amor
u = Range("AF" & Rows.Count).End(xlUp).Row
If u < 5 Then u = 5
Range("AE5:AK" & u).ClearContents
'
j = 5
f = 5
For i = 5 To Range("U" & Rows.Count).End(xlUp).Row + 1
If Cells(i, "U") = "" Then
Range(Cells(f, "T"), Cells(i, "Z")).Copy Cells(j, "AE")
j = j + 46
f = i + 1
End If
Next
MsgBox "Filas copiadas", vbInformation, "TERMINADO"
End Sub‘
F e l i z A ñ o N u e v o . Recuerda valorar la respuesta. G r a c i a s
Muchas gracias por la respuesta.
Creo que funciona bien, pero no lo puedo evaluar porque las celdas de origen contienen fórmulas y al pegar se desvirtúa el resultado. Puedes modificar la macro para que los valores que pegue sean sólo datos.
Gracias de antemano
Te anexo la macro actualizada
Sub CopiarFilas()
'Por.Dante Amor
u = Range("AF" & Rows.Count).End(xlUp).Row
If u < 5 Then u = 5
Range("AE5:AK" & u).ClearContents
'
j = 5
f = 5
For i = 5 To Range("U" & Rows.Count).End(xlUp).Row + 1
If Cells(i, "U") = "" Then
Range(Cells(f, "T"), Cells(i, "Z")).Copy
Cells(j, "AE").PasteSpecial xlValues
j = j + 46
f = i + 1
End If
Next
MsgBox "Filas copiadas", vbInformation, "TERMINADO"
End Sub
