XL 2019 Création d'une macro permettant la création automatique de fichiers CSV

[Arckang]

Bonjour,

Je travaille dans une entreprise d'e-commerce, chaque jour j'achète des produits chez des fournisseurs.
Je rempli mes achats sur un tableau excel, avec la référence et le nom du fournisseur.

Chaque soir, je dois importer un fichier CSV auprès de notre logistique reprenant la référence des produits en cours d'arrivage et le nom du fournisseur.

Pour cela, je crée un fichier CSV pour chaque fournisseur en reprenant les références.

Exemple :

Exemple-123-XX dans une colonne, et le nom du fournisseur : Exemplefournisseur

Cependant, cette tache est lourde car il y a des centaines de références et des dizaines de fournisseurs.

Pourriez-vous m'aider à la création d'une macro et d'un bouton qui automatise cela, en créant les fichiers CSV automatiquement ?

Je vous joins une copie du fichier excel, pour que cela soit plus clair. (pour des questions de confidentialités, j'ai mis de faux exemples)
En soit je dois récupérer les informations de la colonne B et la colonne H, et c'est tout dans le fichier CSV, cependant il peut y avoir plusieurs références pour un même fournisseur

Merci de votre retour

 

[GALOUGALOU]

re arckang bonjour le forum
Si j'ai bien compris, il s'agit pour vous d'exporter et non pas d'importer. Si vous voulez créer un fichier sur excel et éditer un fichier csv par fournisseur, alors ma solution devrait vous convenir
le classeur exemple qui suit devrait vous permettre de mettre au point votre projet
détaillons
Deux feuilles une avec les données que j'ai appelées data, l'autre qui sert d'intermédiaire je l'ai nommé csv.
1er il faut exporter la liste des fournisseurs sans doublons de la colonne H origine à une colonne que j'espère libre colonne AA

Sub SSDoublons()
  Set mondico = CreateObject("Scripting.Dictionary")
      ActiveSheet.Range("aa1:aa100").ClearContents
  For Each c In Range("h1", [h65000].End(xlUp))
    mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  [aa1].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
End Sub

2eme une étape intermédiaire pour identifier les lignes avec le meme fournisseur

Sub vraifaux()
Dim f1 As Worksheet, f2 As Worksheet
Set f1 = Sheets("data")
Set f2 = Sheets("csv")
Application.ScreenUpdating = False
Call SSDoublons
    f1.Select
        With f1
          .Range("ab1:ab1000").ClearContents
            lig1 = f1.Cells(f1.Rows.Count, 27).End(xlUp).Row
                lig2 = f1.Cells(f1.Rows.Count, 7).End(xlUp).Row
                    For Z = 4 To lig1
                        For x = 2 To lig2
                                 If f1.Cells(Z, 27) = f1.Cells(x, 8) Then
                                 f1.Cells(x, 28) = f1.Cells(x, 8)
                                 f1.Cells(1, 28) = f1.Cells(Z, 27)
                            End If
                         Next x
                    Call planning
                f1.Range("ab1:ab1000").ClearContents
            Next Z
        End With
  Application.ScreenUpdating = True
End Sub

3eme consolider les informations identiques

Sub planning()
Dim f1 As Worksheet, f2 As Worksheet
Set f1 = Sheets("data")
Set f2 = Sheets("csv")

f2.Select
 With f2

.Range("a1:T1000").ClearContents

  lig2 = f1.Cells(f1.Rows.Count, 8).End(xlUp).Row
 
   
        For x = 2 To lig2
           y = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
         
           f2.Cells(1, 1) = f1.Cells(1, 28)
     
            If f1.Cells(x, 28) = f1.Cells(x, 8) Then '
            .Cells(y, 1) = f1.Cells(x, 1)
               .Cells(y, 2) = f1.Cells(x, 2)
                .Cells(y, 3) = f1.Cells(x, 3)
                    .Cells(y, 4) = f1.Cells(x, 4)
                        .Cells(y, 5) = f1.Cells(x, 5)
                            .Cells(y, 6) = f1.Cells(x, 6)
                                .Cells(y, 7) = f1.Cells(x, 7)
             
                 End If
             Next x
    End With

Call SaveAsCSV
  Application.ScreenUpdating = True
 f1.Select
End Sub

4eme exporter au format csv avec comme nom, le nom du fournisseur plus un numéro d'impression pour éviter les doublons

Sub SaveAsCSV()
On Error Resume Next
Dim wb As Workbook, ws As Worksheet
Dim strPath As String, strFilename As String, compteur As Long
nom = Sheets("csv").Cells(1, 1)
ct = Sheets("data").Cells(1, 29)
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("csv")
    strPath = wb.Path & Application.PathSeparator
    strFilename = nom & "." & ct & ".csv"
    ws.Copy
    With ActiveWorkbook
        .SaveAs Filename:=strPath & strFilename, _
                FileFormat:=xlCSV, _
                local:=True '? adapter
        .Close savechanges:=False
    End With
    ct = ct + 1
    Sheets("data").Cells(1, 29) = ct
End Sub

super super important
Créer un dossier ou vous allez poser le classeur. Les fichiers csv seront créés dans le même dossier
bonne découverte et bonne récup (évidemment en fonction de vos contraintes il faudra peut-être adapter les macros à la réalité de votre classeur
cdt
galougalou

 

[Arckang]

Bonjour,

je teste ça. Je vous remercie infiniment pour cette solution qui va grandement m’aider.
Merci beaucoup, je vous tiens informé si j’ai besoin d’aide complémentaire

bonne soirée