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