Macro Excel que copie toda la fila de aquella casilla que cumpla X valor

Tengo acceso a una base de datos en Excel y me gustaría poder filtrar de toda esta base de datos aquellas filas que en la columna A contengan el valor "Enseñanza y formación" (ya sea únicamente ese valor o Enseñanza y formación + otro) y que todas estas filas, las copie en una nueva de Excel en ese mismo libro.

Ejemplo de una fila de la base de datos:

Fila 1:

Columna A: Enseñanza y formación | Salud, médica y farmacéutica | Educación, formación y organizaciones | Enseñanza y formación España | Industría química, farmacéutica y pláSticos | Salud, médica y farmacéutica EspañaLaboratorio

Columna B: Perico S.A

Columna C: [email protected]

Columna D: [email protected]

2

2 Respuestas

4.583.925 pts. Sancho, si los perros ladran ...

Revisa la siguiente respuesta y trata de adaptarlo a tu libro

Macro que filtre bace de datos según referencia y copie resultado a otra hoja

Si tienes dificultades para adaptarlo, envíame tu archivo y con gusto lo reviso

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “embv embv

Te anexo la macro

Sub Filtrar_Datos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    'DATOS HOJA1
    Set h1 = Sheets("Hoja1")        'hoja origen con datos
    fila1 = 2                       'fila donde comienzan los datos en la hoja1
    col = "A"                       'columna de códigos
    fila0 = IIf(fila1 > 1, fila1 - 1, fila1)
    coln = Columns(col).Column
    '
    'DATOS HOJA2
    Set h2 = Sheets("Hoja2")        'hoja destino
    fila2 = 5                       'fila donde comienzan los datos en la hoja2
    celda = "B2"                    'celda en la hoja2 con el código
    '
    'INICIO
    h2.Rows(fila2 & ":" & Rows.Count).ClearContents
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u = h1.Range(col & Rows.Count).End(xlUp).Row
    h1.Range("A" & fila0 & ":" & col & u).AutoFilter Field:=coln, Criteria1:="=*" & h2.Range(celda) & "*"
    u = h1.Range(col & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    If u = fila0 Then
        MsgBox "No hay registros con esa referencia"
    Else
        h1.Rows(fila1 & ":" & u).Copy h2.Cells(fila2, "A")
    End If
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
End Sub

.

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

.

Avísame cualquier duda

.

296.125 pts. https://youtube.com/programarexcel...

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas