Private Sub TESTE()
' Optimize
xApplicationOptimize True
' Browse Folder 02
Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
FileDialog.Title = "Selecione a pasta: FINAL"
If FileDialog.Show = -1 Then xPathName = FileDialog.SelectedItems(1) Else Exit Sub
If Right(xPathName, 1) <> "\" Then xPathName = xPathName + "\"
' Browse File 01
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Selecione o arquivo: BASE_J"
.InitialFileName = "*.xlsx"
' Search File 01
If .Show() Then xFileName = .SelectedItems(1) Else Exit Sub
End With
' Open File 01
Workbooks.Open Filename:=xFileName
Set xOldWB = ActiveWorkbook
Application.WindowState = xlMinimized
' ?
xL = 2
Do While Not IsEmpty(xOldWB.Sheets(1).Cells(xL, 1))
NOVAMENTE:
' Variables
xFalse = xOldWB.Sheets(1).Cells(xL, 2)
xTrue = xOldWB.Sheets(1).Cells(xL, 3)
xLine = xOldWB.Sheets(1).Cells(xL, 4)
' Check_01
If xTrue = "" Then
xL = xL + 1
GoTo PULAR
End If
If xOldWB.Sheets(1).Cells(xL, 1) = xOldWB.Sheets(1).Cells(xL - 1, 1) And xTrue <> "" Then GoTo CONTINUA
' Search Files 02
xFileName = "FINAL_" & Format(xOldWB.Sheets(1).Cells(xL, 1), "YYYY_MM_DD") & ".xlsx"
' Open File 02
On Error GoTo PULAR ' DONT WORK <<<
Workbooks.Open Filename:=xPathName & xFileName ' MY PROBLEM <<< WHEN THE FILE DOES NOT EXIST
Set xNewWB = ActiveWorkbook
Application.WindowState = xlMinimized
' Change
CONTINUA:
With ActiveSheet
.Rows(1).Insert
.AutoFilte1rMode = False
With Range("A1", Range("O" & Rows.Count).End(xlUp))
.AutoFilter Field:=2, Criteria1:=xFalse
.AutoFilter Field:=4, Criteria1:=xLine
Range("B1", Range("B" & Rows.Count).End(xlUp)) = xTrue
End With
' Disregard
.AutoFilterMode = False
With Range("B1", Range("B" & Rows.Count).End(xlUp))
.AutoFilter 1, "N/A"
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
.Rows(1).Delete
End With
' Next file
xL = xL + 1
' Check_02
If xOldWB.Sheets(1).Cells(xL, 1) = xOldWB.Sheets(1).Cells(xL - 1, 1) And xTrue <> "" Then GoTo NOVAMENTE
' Save File 02
xNewWB.Save
' Close File 02
xNewWB.Close
PULAR:
Loop
' Save File 01
'xOldWB.Save
' Close File 01
xOldWB.Close
' Optimize
xApplicationOptimize False
End Sub