XL 2016 VBA EXPORT CSV

[ZZ59264]

Bonjour à tous,

Suite à un code fournit sur le site (certainement par JOB75), je souhaiterai a partir de celui-ci exporter une partie du tableau EXEMPLE (sauF colonne ANNEE) les données filtrées, et non toutes les données du tableau en CSV.

L'onglet CSV souhaité montre ce que je souhaite alors que l'onglet CSV actuel montre le résultat de la macro,

Merci d'avance pour votre aide,

Cordialement,

 

[wDog66]

Bonjour ZZ59264,

D'après ce que je vois, vous ne voulez pas la première colonne "Année"
Alors il faut juste modifier la ligne de "Tbl" de cette façon

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

A+

 

[ZZ59264]

Bonjour wDog66,

Merci pour votre retour, qui corrige effectivement la problématique du nombre de colonnes en supprimant la première lors de la création du CSV,

Cependant, il me manque la partie ou l'on conserverai uniquement les lignes filtrées,

Merci d'avance,

Cordialement

 

[wDog66]

Re,

Désolé, ce n'est pas ce que j'avais vu dans votre exemple

Il ne faut donc pas travailler sur une variable tableau, mais directement sur le TS ou les cellules
par exemple

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

 

[cp4]

Bonsoir,

Un essai

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

Bonne soirée.

 

[patricktoulon]

pour le fun
une petite bidouillette

il va de soit que le filtre est respecté bien entendu

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

 

[job75]

Bonjour à tous,

Puisqu'on ne crée qu'un fichier CSV on peut utiliser simplement :

Sub ExportCSV()
Dim fichier$, P As Range
fichier = ThisWorkbook.Path & "\ExportCSV.csv"
Set P = [EXEMPLE]
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
    P.SpecialCells(xlCellTypeVisible).Copy .[A1]
    .Columns(1).Delete
    .SaveAs fichier, xlCSV, Local:=True
    .Parent.Close
End With
MsgBox "'" & fichier & "' a été créé"
End Sub

A+

 

[ZZ59264]

Bonsoir,

Merci à tous pour votre participation, je devrais largement m'en sortir

Bonne soirée à tous,

Cordialement,