XL 2016 VBA EXPORT CSV

Tbl = Range("EXEMPLE").Offset(0, 1).Value

Sub ExportCSV()
  Dim Plage As Range
  Dim CheminNom As String, Derlig As Long
 
  CheminNom = ThisWorkbook.Path & "\" 'Fichier sur le même répertoire
  CheminNom = CheminNom & "Import_" & Sheets("TEST").Cells(2, 1) & Format(Date, "_YYYY_MM_DD") & "_" & Format(Time, "hhmmss") & ".csv"

  Derlig = Sheets("TEST").Range("A" & Rows.Count).End(xlUp).Row
  Set Plage = Sheets("TEST").Range("B5:D" & Derlig)
  Plage.SpecialCells(xlCellTypeVisible).Copy
  Application.ScreenUpdating = False
  Workbooks.Add
  ActiveSheet.Paste
  Application.CutCopyMode = False
  With ActiveWorkbook
    .SaveAs Filename:=CheminNom, FileFormat:=xlCSVUTF8, Local:=True, CreateBackup:=False
    .Close SaveChanges:=False
  End With
  Application.ScreenUpdating = True
 End Sub

Option Explicit

Sub ExportCSV()

   Dim Tbl As Variant, TblTemp As Variant, FileNumber&, i&, j&, chemin$
   Dim d As Object, Code As String, Tbl1(), Tbl2()
   FileNumber = FreeFile

   chemin = ThisWorkbook.Path & "\"   'Fichier sur le même répertoire

   chemin = chemin & "Import_" & Sheets("TEST").Cells(2, 1) & Format(Date, "_YYYY_MM_DD") & "_" & Format(Time, "hhmmss") & ".csv"

   Tbl = Range("EXEMPLE").Value
   '''''''''''''''''''''''''''''''''''''''''''''''
   Code = "C"
   Set d = CreateObject("scripting.dictionary")
   For i = 1 To UBound(Tbl)
      If Tbl(i, 3) = Code Then d(i) = ""   ' on stocke les nos de ligne
   Next i

   Tbl1 = Application.Index(Tbl, Application.Transpose(d.keys), Array(2, 3, 4))   'extract Array

   ReDim TblTemp(LBound(Tbl1, 2) To UBound(Tbl1, 2))

   Open chemin For Output As #FileNumber

   For i = LBound(Tbl1, 1) To UBound(Tbl1, 1)
      For j = 1 To UBound(Tbl1, 2)
         TblTemp(j) = Tbl1(i, j)
      Next j
      Print #FileNumber, Join(TblTemp, ";")
   Next i
   Close #FileNumber

   MsgBox "Terminé!"
End Sub

Sub test()
    CopyFilterTable [A1:C12], Environ("userprofile") & "\desktop\output.csv"
End Sub

Sub CopyFilterTable(rng As Range, lPath)
    Dim X&
    rng.SpecialCells(xlCellTypeVisible).Copy
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        X = FreeFile: Open lPath For Output As #X: Print #X, Replace(.GetText(), vbTab, ";") & vbCrLf & "bidule"
        Close #X
        Application.CutCopyMode = False
    End With
    MsgBox "votre fichier a été sauvegardé dans" & vbCrLf & lPath
End Sub