Forum Discussion

a7024782's avatar
a7024782
Brass Contributor
Jan 04, 2022
Solved

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.

  • 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

2 Replies

  • 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