Reconocer Ultima Fila VBA Excel

Tengo el siguiente código para pasar información de una hoja a otra en base a unos datos, necesito saber como puedo detectar la ultima fila con datos y de hay siga pegando la información puesto que para algunos datos no logro tener coherencia debido a que no condicen.

Sub CopiarInformacion()
Application.ScreenUpdating = False
Sheets("Formulario"). Range("D6").Copy Destination:=Sheets("Datos"). Range("B1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G6").Copy Destination:=Sheets("Datos"). Range("C1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("D8").Copy Destination:=Sheets("Datos"). Range("D1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G8").Copy Destination:=Sheets("Datos"). Range("E1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("D10").Copy Destination:=Sheets("Datos"). Range("F1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G10").Copy Destination:=Sheets("Datos"). Range("G1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("D12").Copy Destination:=Sheets("Datos"). Range("H1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G12").Copy Destination:=Sheets("Datos"). Range("I1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("D14").Copy Destination:=Sheets("Datos"). Range("J1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G14").Copy Destination:=Sheets("Datos"). Range("K1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("D16").Copy Destination:=Sheets("Datos"). Range("L1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G16").Copy Destination:=Sheets("Datos"). Range("M1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("G18").Copy Destination:=Sheets("Datos"). Range("O1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K6").Copy Destination:=Sheets("Datos"). Range("S1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N6").Copy Destination:=Sheets("Datos"). Range("T1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K8").Copy Destination:=Sheets("Datos"). Range("U1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N8").Copy Destination:=Sheets("Datos"). Range("V1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K10").Copy Destination:=Sheets("Datos"). Range("W1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N10").Copy Destination:=Sheets("Datos"). Range("X1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K12").Copy Destination:=Sheets("Datos"). Range("Y1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N12").Copy Destination:=Sheets("Datos"). Range("Z1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K14").Copy Destination:=Sheets("Datos"). Range("AA1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N14").Copy Destination:=Sheets("Datos"). Range("AB1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K16").Copy Destination:=Sheets("Datos"). Range("AC1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N16").Copy Destination:=Sheets("Datos"). Range("AD1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("K18").Copy Destination:=Sheets("Datos"). Range("AE1048576").End(xlUp).Offset(1, 0)
Sheets("Formulario"). Range("N18").Copy Destination:=Sheets("Datos"). Range("AF1048576").End(xlUp).Offset(1, 0)
If Range("G18") = "1" Then
Sheets("Formulario").Range("G20:I20").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "2" Then
Sheets("Formulario").Range("G20:I21").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "3" Then
Sheets("Formulario").Range("G20:I22").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "4" Then
Sheets("Formulario").Range("G20:I23").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "5" Then
Sheets("Formulario").Range("G20:I24").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "6" Then
Sheets("Formulario").Range("G20:I25").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "7" Then
Sheets("Formulario").Range("G20:I26").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "8" Then
Sheets("Formulario").Range("G20:I27").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "9" Then
Sheets("Formulario").Range("G20:I28").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
If Range("G18") = "10" Then
Sheets("Formulario").Range("G20:I29").Copy Destination:=Sheets("Datos").Range("P1048576").End(xlUp).Offset(1, 0)
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
Sheets("Formulario").Range("D6,G6,D8,G8,D10,G10,D12,G12,D14,G14,D16,G16,G18,K6,N6,K8,N8,K10,N10,K12,N12,K14,N14,K16,N16,K18,N18"). ClearContents
Sheets("Formulario").Range("E30:H45").Copy Destination:=Sheets("Formulario").Range("E19:H30")
Call Sheets("Datos").ConversionMayus
Application.ScreenUpdating = True

End Sub

1 Respuesta

Respuesta
2

Por lo que veo, tu última fila con datos está en función de lo que se pegue en la columna P y esto depende el número (puede ser del 1 al 10), que tienes en la celda G18

Entonces lo que se debe hacer es buscar la última fila con datos de la columna P.

Me tomé la libertar de depurar tu macro, quedaría de esta forma:

Sub CopiarInformacion()
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Formulario")
    Set h2 = Sheets("Datos")
    'última fila con datos de la columna P
    u = h2.Range("P" & Rows.Count).End(xlUp).Row + 1
    'celdas origen
    ori = Array("D6 ", "G6 ", "D8 ", "G8 ", "D10", "G10", "D12", "G12", "D14", "G14", _
                "D16", "G16", "G18", "K6 ", "N6 ", "K8 ", "N8 ", "K10", "N10", "K12", _
                "N12", "K14", "N14", "K16", "N16", "K18", "N18")
    'celdas destino
    des = Array("B ", "C ", "D ", "E ", "F ", "G ", "H ", "I ", "J ", "K ", _
                "L  ", "M  ", "O  ", "S  ", "T  ", "U  ", "V  ", "W  ", "X  ", "Y  ", _
                "Z  ", "AA ", "AB ", "AC ", "AD ", "AE ", "AF ")
    For j = LBound(ori) To UBound(ori)
        h1.Range(WorksheetFunction.Trim(ori(j))).Copy h2.Cells(u, WorksheetFunction.Trim(des(j)))
    Next
    Select Case h1.Range("G18")
        Case "1":  f = 20
        Case "2":  f = 21
        Case "3":  f = 22
        Case "4":  f = 23
        Case "5":  f = 24
        Case "6":  f = 25
        Case "7":  f = 26
        Case "8":  f = 27
        Case "9":  f = 28
        Case "10": f = 29
        Case Else: f = 20
    End Select
    H1.Range("G20:I" & f). Copy h2.Cells(u, "P")
    '
    ActiveWorkbook. Save
    Application.ScreenUpdating = True
    Sheets("Formulario").Range("D6,G6,D8,G8,D10,G10,D12,G12,D14,G14,D16,G16,G18,K6,N6,K8,N8,K10,N10,K12,N12,K14,N14,K16,N16,K18,N18"). ClearContents
    Sheets("Formulario"). Range("E30:H45").Copy Destination:=Sheets("Formulario"). Range("E19:H30")
    Call Sheets("Datos").ConversionMayus
    Application.ScreenUpdating = True
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas