Saltar al contenido

Recommended Posts

publicado

Por favor el código abajo descrito , necesite que funcione con tablas

 

Sub REP_FUNC()
'BUSQUEDA POR CEDULA
    Set h1 = Sheets("DATA")
    Set h2 = Sheets("REP-FUNC")
    u2 = h2.Range("F" & Rows.Count).End(xlUp).Row
    If u2 < 2 Then u2 = 2 'linea de inicio
    h2.Range("F" & u2 & ":N" & u2).ClearContents
    'h2.Range("F" & u2 & ":K" & u2).ClearContents
    j = 2
    celda = "A1" 'CELDA DE LA CONSULTA
    Set r = h1.Columns("E") 'COLUMNA DE CONSULTA DATA
    Set b = r.Find(h2.Range(celda), lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            h1.Range(h1.Cells(b.Row, "A"), h1.Cells(b.Row, "I")).Copy
            'h1.Range(h1.Cells(b.Row, "F"), h1.Cells(b.Row, "K")).Copy
            h2.Cells(j, "F").PasteSpecial Paste:=xlValues
            j = j + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
End Sub

Conéctate para comentar

Podrás dejar un comentario después de conectarte



Conéctate ahora
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.