Diviser un tableau en différents classeurs suivant une colonne du tableau

Bonjour à tous !

Pour mon premier post sur le forum (et pourtant adepte depuis longtemps - Merci à tous pour l'aide que vous m'avez déjà apportée sans le savoir!), je lance un appel à l'aide pour un sujet VBA qui a déjà été souvent discuté mais pour lequel je n'arrive pas à adapter le code en fonction de mon besoin.

Dans le fichier en annexe, vous trouverez un tableau que je souhaite diviser et filtrer par nom de fournisseur (colonne D). Les cellules avec valeurs doivent être formatées en texte, les cellules vide, formatées en standard. Je dois respecter la mise en forme afin que le fichier de destination garde les couleurs du tableau. La première ligne du tableau est à rapporter sur chaque tableau de chaque classeurs

Enfin, je dois renommer chaque fichier de la manière suivante : "[Nom Fournisseur]_Update" et les exporter dans un dossier défini.

Novice en VBA, je ne n'ai pas réussi à m'aider des autres posts du forum pour résoudre ce casse-tête VBA ... Mais je sais qu'il y a des experts parmi-vous de ce genre de cas

Merci d'avance,

Oli.V95

Bonjour Oliv, bonjour le forum,

Le code ci-dessous enregistre les fichiers dans le même dossier que le fichier source :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (CHemin d'Accès)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
'Dim K As Integer 'déclare la variable CS (Classeur Source)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim NC As Workbook 'déclare la variable NC (Nouveau Classeur)
Dim NO As Worksheet 'déclare la variable NO (Nouvel Onglet)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Master") 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 4)) = "" 'alimente le dictionnaire D avec les données en colonne 4 (Nom Fournisseur)
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle sur tous les élément du tableau tenporaire TMP
    If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les lignes
    OS.Range("A1").CurrentRegion.AutoFilter 4, TMP(J) 'fitre la colonne 4 de l'onglet OS avec TMP(J) comme critére
    Set NC = Workbooks.Add 'définit le classeur NC en ajoutant un classeur vierge
    Set NO = NC.Worksheets(1) 'définit l'onglet NO
    OS.Range("A1").CurrentRegion.Copy 'copy les cellules adjacentes a A1
    NO.Range("A1").PasteSpecial (xlPasteAllUsingSourceTheme) 'colle les thèmes
    NO.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
    OS.Range("A1").PasteSpecial (xlPasteValues) 'colle les valeurs
    NO.Name = TMP(J) 'renomme l'onglet NO
    NC.SaveAs CA & TMP(J) & "_Update", 51 'enregistre sou le classeur NC
    NC.Close 'ferme le classeur NC
Next J 'prochain élément de la boucle
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les lignes
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Bonjour ThauThème,

Magnifique ! C'est exactement ce qu'il me fallait ! Merci à toi

Juste 2 questions :

- Comment faire si je souhaite que le nom du classeur créé soit nommé de la manière suivante : [Rayon]_ [Nom Fournisseur]_"Update"

- Est-il possible que dans le fichier créé, la largeur des colonnes soit automatiquement ordonnée ?

Merci d'avance !

OliV.95

Bonjour,

Bonjour ThauTheme, plus rapide que moi

Comme je l'ai fini, je le place tout de même

Re,

- Comment faire si je souhaite que le nom du classeur créé soit nommé de la manière suivante : [Rayon]_ [Nom Fournisseur]_"Update"

Remplace la ligne :

NC.SaveAs CA & TMP(J) & "_Update", 51 'enregistre sou le classeur NC

par :

NC.SaveAs CA & NO.Range("F2").Value & "_" & TMP(J) & "_Update", 51 'enregistre sou le classeur NC

- Est-il possible que dans le fichier créé, la largeur des colonnes soit automatiquement ordonnée ?

Désolé mais je ne comprends pas ce que tu veux dire...

Bonjour M12,

Merci à toi également pour ta contribution ! Dans ton code, la ventilation se fait par onglet, il me la fallait par classeur. Je suis sûr que cela pourra néanmoins aider d'autre adeptes du forum

@ThauThème :

Super, merci !

Quand je parle d'ordonner automatiquement les colonnes, je parle de la largeur des colonnes que l'on peut agrandir ou rétrécir en fonction de la taille des cellules (le double clique que l'on fait entre la colonne A et la colonne B pour que la colonne A change de longueur en fonction du nombre de caractères du texte encodé dans ses cellules) ; mais je ne sais pas si cela est possible ne VBA.

Dans l'exemple que j'ai donné, je n'ai sélectionné que les 23 premières lignes d'un tableau qui en fait 230.000 ... Lorsque j'ai essayé de lancer la macro sur ce tableau, un beug est apparu sur la ligne :

For I = 2 To UBound(TV, 1)

As-tu une idée d'où cela peut venir ?

Merci d'avance,

Oli.V95

Re,

La variable I est déclarée de type Integer il faut la déclarer de type Long

Remplace Dim I As Integer par Dim I As Long...

Je regarde pour ajuster la largeur des colonnes...

Re,

En pièce jointe la version 02 avec toutes les modifications...

Le code :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (CHemin d'Accès)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim NC As Workbook 'déclare la variable NC (Nouveau Classeur)
Dim NO As Worksheet 'déclare la variable NO (Nouvel Onglet)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Master") 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 4)) = "" 'alimente le dictionnaire D avec les données en colonne 4 (Nom Fournisseur)
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle sur tous les élément du tableau tenporaire TMP
    If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les lignes
    OS.Range("A1").CurrentRegion.AutoFilter 4, TMP(J) 'fitre la colonne 4 de l'onglet OS avec TMP(J) comme critére
    Set NC = Workbooks.Add 'définit le classeur NC en ajoutant un classeur vierge
    Set NO = NC.Worksheets(1) 'définit l'onglet NO
    OS.Range("A1").CurrentRegion.Copy 'copy les cellules adjacentes a A1
    NO.Range("A1").PasteSpecial (xlPasteAllUsingSourceTheme) 'colle les thèmes
    NO.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
    OS.Range("A1").PasteSpecial (xlPasteValues) 'colle les valeurs
    NO.Name = TMP(J) 'renomme l'onglet NO
    NO.Columns("A:H").AutoFit 'ajuste la largeur des colonnes
    NC.SaveAs CA & NO.Range("F2").Value & "_" & TMP(J) & "_Update", 51 'enregistre sou le classeur NC
    NC.Close 'ferme le classeur NC
Next J 'prochain élément de la boucle
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les lignes
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier :

Re ThauThème,

Merci pour cette nouvelle synthèse !

Ce code a bien créé autant de fichier qu'il y a de fournisseurs mais il n'y a pas eu de filtre : tous les fichiers contiennent tous les articles de tous les fournisseurs.

Il y a un beug à la ligne

OS.Range("A1").PasteSpecial (xlPasteValues) 'colle les valeurs

Ai-je mal fait quelque chose ?

Oli.V95

Re,

Nouvelle version en pièce jointe :

ThauThème,

Super! Tout fonctionne, je n'ai plus de beug, sauf un dernier point :

Dans les fichiers générés, sont toujours présentes les lignes de tous les fournisseurs. Je vois que le tri est fait (les lignes du fichier du fournisseur sélectionné sont regroupées) mais les lignes des autres fournisseurs sont ajoutées à la suite.

Ce qui est étrange, ce que je n'ai pas cela avec ton exemple, chaque fournisseur dispose bien de ses propres lignes ...

Oli.V95

Re,

Étrange en effet mais je ne pourrais pas t'aider car chez moi ça fonctionne... À moins que tu ne nous propose ton fichier...

ThauThème,

Ca ne marchait pas dès le moment où je lançait la macro sur un autre fichier que celui que tu as compilé, mais ce n'est pas du tout grave, je peux m'en sortir ainsi.

Tout est solutionné pour moi, un grand merci !

Et pour rester sur une dernière question ; dans le code :

 NC.SaveAs CA & NO.Range("F2").Value & "_" & TMP(J) & "_Update", 51

Que signifie le "51" ?

Oli.V95

Re,

C'est le type de classeur. 51 correspond au classeur par défaut...

Bonjour ThauThème,

Merci à toi pour toutes ces explications !

Le sujet est pour moi clôturé, à bientôt !

Oli.V95