Para Dante: Macro que pegue datos en base a datos variables, excluyendo algunos en base a una restriccion

Del macro que busca y pega datos, olvide mencionar que si en la columna G "Mes", si en lugar de venir algún mes, viene el texto "REPOSICIÓN",  entonces debe irse al siguiente resultado que se encuentre más cercano a las últimas hojas.

Ejemplo:

Se pide en la hoja "Números de parte solicitados" el número "096396262DDD". En la hoja 20 vienen los siguientes datos:

En la hoja 18 vienen los siguientes datos:

El macro deberá saltarse los primeros datos encontrados porque en la columna G "Mes", viene el texto "REPOSICIÓN" por lo que deberá pegar los de la hoja 18, que son los siguientes más recientes, obteniendo lo siguiente:

Espero que puedas ayudarme.

Saludos y de antemano gracias

1 Respuesta

Respuesta
1

Te anexo la macro actualizada

Sub CopiarInformacion()
'Por.Dante Amor
    ruta = ThisWorkbook.Path
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set h2 = l1.Sheets("Solicitud")
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo de excel"
        .Filters.Add "Archivo xls", "*.xls*"
        .AllowMultiSelect = False
        .InitialFileName = ruta
        If .Show Then
            Application.ScreenUpdating = False
            arch = .SelectedItems.Item(1)
            Set l2 = Workbooks.Open(arch)
            For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
                num = h1.Cells(i, "A")
                k = h2.Range("E" & Rows.Count).End(xlUp).Row + 1
                For j = l2.Sheets.Count To 1 Step -1
                    Set h = l2.Sheets(j)
                    Set r = h.Columns("E")
                    Set b = r.Find(num)
                    If Not b Is Nothing Then
                        ncell = b.Address
                        If h.Cells(b.Row, "G") <> "REPOSICIÓN" Then
                            Do
                                h.Rows(b.Row).Copy h2.Rows(k)
                                k = k + 1
                                Set b = r.FindNext(b)
                            Loop While Not b Is Nothing And b.Address <> ncell
                            Exit For
                        End If
                    End If
                Next
            Next
            l2.Close False
        End If
        Application.ScreenUpdating = True
        h2.Select
        MsgBox "Proceso terminado", vbInformation, "COPIAR INFORMACIÓN"
    End With
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas