SOLVED

Macro para copiar a otra hoja ultima fila de rangos discontinuos

Brass Contributor

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.

2 Replies
best response confirmed by a7024782 (Brass Contributor)
Solution

@a7024782 

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
Funciono perfecto, gracias
1 best response

Accepted Solutions
best response confirmed by a7024782 (Brass Contributor)
Solution

@a7024782 

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

View solution in original post