Forum Discussion
a7024782
Jan 04, 2022Brass Contributor
Macro para copiar a otra hoja ultima fila de rangos discontinuos
Tengo esta macro que me permite copiar los datos de la hoja1 a la hoja2 que funciona según lo requerido.
Me gustaría modificarla para que copiara solamente las ultimas celdas de rangos discontinuos de la hoja1 y las pegara en las ultimas celdas vacías de la hoja2.
Este es el código:
Sub Copiar_Discontinuo()
With Sheets("Hoja1")
.Range("A2:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy _
Destination:=Sheets("Hoja2").Range("A" & Sheets("Hoja2").Cells(Rows.Count, 1).End(xlUp).Row + 1)
Range("A1").Select
End With
End Sub
Entonces, donde dice .Range("A2:E"... Lo quiero modificar para que copie las ultimas celdas de las columnas A, B, E, y Z, por ejemplo y que las pegue en la hoja2, en las ultimas celdas vacías de las columnas A, B, C y D.
Sub Copiar_Discontinuo() Dim w1 As Worksheet Dim w2 As Worksheet Dim m1 As Long Dim m2 As Long Set w1 = Worksheets("Hoja1") m1 = w1.Range("A" & w1.Rows.Count).End(xlUp).Row Set w2 = Worksheets("Hoja2") m2 = w2.Range("A" & w2.Rows.Count).End(xlUp).Row + 1 w1.Range("A" & m1 & ",B" & m1 & ",E" & m1 & ",Z" & m1).Copy _ Destination:=w2.Range("A" & m2) End Sub
2 Replies
Sub Copiar_Discontinuo() Dim w1 As Worksheet Dim w2 As Worksheet Dim m1 As Long Dim m2 As Long Set w1 = Worksheets("Hoja1") m1 = w1.Range("A" & w1.Rows.Count).End(xlUp).Row Set w2 = Worksheets("Hoja2") m2 = w2.Range("A" & w2.Rows.Count).End(xlUp).Row + 1 w1.Range("A" & m1 & ",B" & m1 & ",E" & m1 & ",Z" & m1).Copy _ Destination:=w2.Range("A" & m2) End Sub- a7024782Brass ContributorFunciono perfecto, gracias