0

I am making a subroutine that looks for a match with a certain text (variable) in a specific column, after finding at least 1 match it copies a range of text to another book.

The problem is that, if this routine is invoked from another or by link (automated) it does not find any match, when it is done manually from VBA they work perfectly.

I hope you can help me find the problem or suggest where the problem may be, I'm starting with vba in excel and the truth is that I can no longer find a solution searching for information on the net or doing my discard tests, in case it is necessary I detail the code:

Sub elFiltro():
Dim contador1 As Integer
'Declarando variables
lastRow4 = Cells(Rows.Count, "E").End(xlUp).Row
lastRowUlt = Cells(Rows.Count, "AB").End(xlUp).Row
archTrab = Workbooks("VerifCorre.xlsm").Worksheets(1).Range("C4").Value
nombArch = Format(Now(), "YYYY-MMM-DD")

''Eliminar luego de probar
Workbooks(nombArch & ".xlsx").Activate 'Eliminar luego
Sheets(1).Name = "Res." 'Eliminar luego

'Seleccionando libro de origen
Workbooks(archTrab).Activate
Range("D1").Select

'Ubica el cursor a la celda A1 y activar autofiltro
If Not ActiveSheet.AutoFilterMode Then
   ActiveSheet.Range("A1").AutoFilter
End If

Dim tipComp(1 To 4) As String
tipComp(1) = "BN0"
tipComp(2) = "BV0"
tipComp(3) = "FN0"
tipComp(4) = "FA0"

Dim comp As Variant
For Each comp In tipComp

    For contador = 4 To 1 Step -1
        datBuscado = comp & contador

        Set busDato = Range("$C$1", Cells(lastRowUlt, 4)).Find(datBuscado, , xlValues, xlWhole, , , True)

        If busDato Is Nothing Then
            MsgBox "No hay coincidencias con: " & datBuscado

        Else
            MsgBox "Hay al menos 1 coincidencia con " & datBuscado & " , procederemos a incluir información encontrada"

            Workbooks(nombArch & ".xlsx").Activate
            Worksheets.Add.Name = datBuscado
            ActiveWorkbook.Save

            'Seleccionando libro de origen
            Workbooks(archTrab).Activate
            Range("D1").Select

            'Aplicando filtro en columna 3 (C) con el criterio datBuscado
            ActiveSheet.Range("$A$1", Cells(lastRowUlt, 29)).AutoFilter Field:=4, Criteria1:=datBuscado

            Workbooks(archTrab).Worksheets(1).Range("$A$1", Cells(lastRow4, 5)).Copy Destination:=Workbooks(nombArch & ".xlsx").Worksheets(datBuscado).Range("A1")
            ActiveWorkbook.Save

            'Eliminando columna innecesaria
            Workbooks(nombArch & ".xlsx").Activate
            Sheets(datBuscado).Select
            Columns("B:B").Select
            Selection.Delete Shift:=xlToLeft

            'Adicionando títulos a las columnas
            Range("B1").Select
            ActiveCell.FormulaR1C1 = "b"
            Range("C1").Select
            ActiveCell.FormulaR1C1 = "c"
            Range("D1").Select
            ActiveCell.FormulaR1C1 = "d"
            Range("E1").Select
            ActiveCell.FormulaR1C1 = "e"

            'Guardando cambios
            ActiveWorkbook.Save

            'Volviendo a libro origen
            Windows(archTrab).Activate

            'Quitando el criterio del filtro (mostrando toda la información)
            ActiveSheet.ShowAllData
            ActiveWorkbook.Save

        End If
    Next contador

Next comp

Workbooks(nombArch & ".xlsx").Activate
Sheets("Res.").Move Before:=Worksheets(1)

'Guardando cambios
ActiveWorkbook.Save

End Sub

0 Answers0