Problème macro pour faire un publi postage

loulou_yellow

XLDnaute Nouveau
Bonjour

voilà depuis 2 jours que je m'arrache les cheveux parce-que je n'arrive pas à faire une opération qui initialement me paraissait simple !!!

J'ai réalisé un macro me permettant de faire un publipostage à partir de données fournisseur / référence / couleur complétées dans le fichier "tableau publi.xlsm" (cf en pj)

La trame vierge qui me permet de créer ces fichiers est le fichier PDT.xlsm contenant:
- un onglet "GENERAL"
- un onglet "PRODUIT" dans le quel je mets toutes les infos de la référence en question

Le but est de faire un publipostage créeant un fichier par fournisseur comportant un onglet par référence (le nom de l'onglet sera le nom de la référence)
Jusque là, j'arrive
Le problème c'est que je veux mettre dans les cases C17,C18,C19,C20,C21,C22 de l'onglet de la référence choisie respectivement les différents coloris de la référence dans la limite de 6 coloris maxi par produit

PAr example, l'onglet "A" du 1er fichier crée (de la référence A) aura en case C17, C18, C19 ; respectivement le coloris 1, coloris 2, coloris 3. LEs cases C20-C21-C22 étant vides
L'onglet "B" aura en case C17, C18, les coloris 4 et coloris 5? Le reste étant vide etc

Ci dessous les codes
(j'ai supprimé les trucs que j'ai tenté histoire de pas me taper la honte devant les expert de ce site)

Code:
Sub publipostage()

'Macro crée par Loulou

Application.ScreenUpdating = False

Dim tab_publi, répertoire, frn, ref, col1, col2, col3, col4, col5, col6
Dim indice_ref, fihier_DT, FICHIER_INITIAL, couleur, nom_onglet, param
Dim l, k, m As Integer

nbre_ligne = Range("I9999").End(xlUp).Row
Fichier_PDT = "C:\Publipostage Fichier PDT\PDT.xlsm"
                 
For j = 4 To nbre_ligne

                Windows("Tableau publi.xlsm").Activate
                frn = Cells(j, 4)
                ref = Cells(j, 8)
                      
       'si nouveau fournisseur
     If frn <> Cells(j - 1, 4).Value Then
            
            nom_onglet = "PRODUIT"
            répertoire = Cells(j, 1)
            liste_ref = ""
            nbre_frn = nbre_frn + 1
            Workbooks.Open Filename:= _
                    Fichier_PDT
            FICHIER_INITIAL = ActiveWorkbook.Name
            Windows(FICHIER_INITIAL).Activate
      Else
            nbre_ref = nbre_ref + 1
      End If
            
            Windows("Tableau publi.xlsm").Activate
            
           'si nouvelle ref
           If ref <> Cells(j + 1, 8) Then
                                 
              'copie l'onglet PRODUIT  et complète l'onglet
                
                Windows(FICHIER_INITIAL).Activate
                Sheets("PRODUIT").Copy After:=Sheets(nom_onglet)
                ActiveSheet.Name = ref
                Range("H9").Value = ref
                nom_onglet = ref
               
            End If
                        
                'Enregistre le fichier
                Windows("Tableau publi.xlsm").Activate
                
        If frn <> Cells(j + 1, 4).Value Then
                Windows(FICHIER_INITIAL).Activate
                Sheets("PRODUIT").Select
                Application.DisplayAlerts = False
                ActiveWindow.SelectedSheets.Delete
                
                Windows(FICHIER_INITIAL).Activate
                Sheets("GENERAL").Select
                Application.DisplayAlerts = True
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs Filename:="" & répertoire & "\" & "Fichier produits - " & frn & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False
                FICHIER_INITIAL = ActiveWorkbook.Name
                Application.DisplayAlerts = True
            
                Windows(FICHIER_INITIAL).Activate
                ActiveWorkbook.Close
              
          End If
        Next
End Sub
 

Pièces jointes

  • Tableau publi.xlsm
    87.7 KB · Affichages: 37

Discussions similaires

Statistiques des forums

Discussions
312 485
Messages
2 088 802
Membres
103 971
dernier inscrit
abdazee