Macro para copiar datos de una hoja a otra en la fila vacía siguiente
Los expertos, espero que por favor me colaboren con una macro para esta inquietud
Tengo un libro de excel que tiene varias hojas, de las cuales de una de ellas quiero copiar datos que van de la columna A la columna M, los rangos a copiar son discontinuos y luego pegarlos en otra hoja a partir de la columna A, B, C y DE en el la última fila vacía que encuentre, algo así como la imagen siguiente:
1 Respuesta
Respuesta de Dante Amor
4
Te anexo la macro
Sub Copiar_Datos()
'Por Dante Amor
Set h1 = Sheets("origen") 'hoja origen
Set h2 = Sheets("destino") 'hoja destino
'
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("A2:A" & u1 & ",B2:C" & u1 & ",J2:J" & u1).Copy h2.Range("A" & u2)
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("A2:A" & u1 & ",D2:E" & u1 & ",K2:K" & u1).Copy h2.Range("A" & u2)
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("A2:A" & u1 & ",F2:G" & u1 & ",L2:L" & u1).Copy h2.Range("A" & u2)
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("A2:A" & u1 & ",H2:I" & u1 & ",M2:M" & u1).Copy h2.Range("A" & u2)
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
¡Gracias!
Super esta genial, me va ahorrar mucho tiempo, mil gracias Experto Dante Amor
Será posible hacerlo con un bucle de repetición, el mismo procedimiento, ya que estuve intentando con For Each o For Next pero no logre. De esta manera me ayudarías también a entender su uso.
Te anexo una opción con un bucle
Sub Copiar_Datos()
'Por Dante Amor
Set h1 = Sheets("origen") 'hoja origen
Set h2 = Sheets("destino") 'hoja destino
'
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
c1 = Array("B", "D", "F", "H")
c2 = Array("C", "E", "G", "I")
c3 = Array("J", "K", "L", "M")
For i = LBound(c1) To UBound(c2)
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("A2:A" & u1 & "," & c1(i) & "2:" & c2(i) & u1 & "," & c3(i) & "2:" & c3(i) & u1).Copy h2.Range("A" & u2)
Next
MsgBox "Fin"
End Sub
