Sub csvTable2(lName As String, tName As String, fName As String)
     
    Dim tbl As ListObject
    Set tbl = Worksheets(lName).ListObjects(tName)
    Application.DisplayAlerts = False
    Workbooks.Add

    arr1 = tbl.Range("A1").Value
    Range("A1").Value = arr1

    With ActiveWorkbook
      .SaveAs fName, xlCSV, local:=False
      .Saved = True
      .Close
    End With
    Application.DisplayAlerts = True
     
End Sub

Sub ExtractExcludingList()

Dim initialDataRange As Range
Dim exclusionsDataRange As Range
Dim initialDataArray() As Variant
Dim exclusionsDataArray() As Variant
Dim rowsToPreserve() As Variant

With ThisWorkbook.Worksheets(2)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set initialDataRange = .Range(.Cells(1, 1), .Cells(lastRow, 1))
initialDataArray = initialDataRange.Value
End With

With ThisWorkbook.Worksheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set exclusionsDataRange = .Range(.Cells(2, 1), .Cells(lastRow, 1))
exclusionsDataArray = exclusionsDataRange.Value
End With

matchFlag = False
For i = LBound(initialDataArray) To UBound(initialDataArray)
For j = LBound(exclusionsDataArray) To UBound(exclusionsDataArray)
If InStr(initialDataArray(i, 1), exclusionsDataArray(j, 1)) > 0 Then
matchFlag = True
End If
Next j
If matchFlag = False Then
myCount = myCount + 1
ReDim Preserve rowsToPreserve(myCount - 1)
rowsToPreserve(myCount - 1) = i
End If
matchFlag = False

Next i

result = Application.Index(initialDataArray, Application.Transpose(rowsToPreserve), 1)

With ThisWorkbook.Worksheets(3)
Set pasteDataRange = .Range(.Cells(1, 1), .Cells(UBound(result), 1))
pasteDataRange.Value = result
End With

End Sub

Function ContainsOneOfThese(stringRange As Range, substringsRange As Range) As String

    Dim inString As String
    Dim substringsArray As Variant
    
    inString = stringRange.Value
    substringsArray = substringsRange.Value
    
    For i = LBound(substringsArray) To UBound(substringsArray)
       
        If InStr(inString, substringsArray(i, 1)) > 0 Then
            
            ContainsOneOfThese = "Да"
            Exit Function
        
        End If

    Next i
    
    ContainsOneOfThese = "Нет"
    
End Function

        '.Item(CDO_Cnf & "smtpusessl") = True