Maccro pour multiplier deux listes de données entre elles

Bonjour à tous,

Je viens demander votre aide pour automatiser une tache que j'ai à répéter régulièrement et qui me prend pas mal de temps surtout lorsque j'ai des modifications de dernière minutes qui m'oblige à tout recommencer ....

C'est assez simple :

Il s'agit d'un fichier avec une liste de produits que j'envoie à différents responsable de zone et qui doivent me le retourner rempli.

Il y a deux listes :

1. Une liste de Marché : MARCHE

• marché 1
  marché 2
  marché 3

2. Une liste de produit : PRODUCT LIST

• Produit 1
  Produit 2
  Produit 3

J'aurais besoin qu'excel prenne chaque ligne du tableau de l'onglet Marché (col F à H sans la colonne KEY)

pour ensuite la coller dans un troisième onglet autant de fois qu'il y a un produit dans l'onglet product list

RESULTAT :

• Marché 1 * Produit 1
  Marché 1 * Produit 2
  Marché 1 * Produit 3
  Marché 2 * Produit 1
  Marché 2 * Produit 2
  Marché 2 * Produit 3
  Marché 3 * Produit 1
  Marché 3 * Produit 2
  Marché 3 * Produit 3

Bien sur la liste de produit ou des marché doit pouvoir changer de taille (nombre de ligne)

Voila j’espère que ma demande est claire et qu'une âme bienveillante puisse m'aider, malheureusement mes compétences en VBA ne me permette pas encore de rédiger ce code

Salut Antoine,

quelque chose comme ça?

Private Sub cmdGO_Click()
'
Dim tData1, tData2, tData3
'
With Worksheets("MARCHE")
    iRow = .Range("F" & Rows.Count).End(xlUp).Row
    tData1 = .Range("F4:H" & iRow).Value
End With
'
With Worksheets("Product List")
    iRow = .Range("E" & Rows.Count).End(xlUp).Row
    tData2 = .Range("E11:K" & iRow).Value
End With
'
ReDim tData3(10, UBound(tData2) * UBound(tData1))
'
For x = 1 To UBound(tData1)
    For y = 1 To UBound(tData2)
        iIdx = iIdx + 1
        For Z = 0 To 9
            If Z < 3 Then
                tData3(Z, iIdx - 1) = tData1(x, Z + 1)
            Else
                tData3(Z, iIdx - 1) = tData2(y, Z - 2)
            End If
        Next
    Next
Next
'
With Worksheets("RESULTAT")
    iRow = .Range("B" & Rows.Count).End(xlUp).Row
    If iRow < 11 Then iRow = 11
    .Range("B11:AAA" & iRow).ClearContents
    .Range("B11").Resize(iIdx, 10).Value = WorksheetFunction.Transpose(tData3)
    .Columns("B:K").AutoFit
    .Activate
End With
'
End Sub

A+

Hello Curulis, cela fonctionne parfaitement !! Mille mercis !

Je me permets d 'en demander plus du coup si jamais tu as le temps,

J'aurais besoin qu'une fois cette liste de marché * produit créée, on puisse la répartir bout par bout (en copiant collant) dans les onglets qui servent aux marchés,

En ajoutant dans l'onglet RÉSULTAT une clef par exemple Market & Super Market

et qu'ensuite avec l'aide de l'onglet "Liste responsable TAD" il puisse allez coller les lignes correspondante à la clef dans l'onglet indiqué en Col E du tableau des responsable ?

Merci beaucoup si tu as le temps de m'aider ! et Merci pour ton aide déjà !

Bonne journée !

Salut Antoine,

Bonsoir le forum,

voici la petite rajoute à ta macro! 8)

Tout se fait évidemment à partir du petit bouton rouge!

With Worksheets("Liste Responsable TAD")
    iRow = .Range("A4").End(xlDown).Row
    For x = 5 To iRow                                               'effacement des feuilles TAD
        With Worksheets(CStr(.Cells(x, 5)))
            .Range("A8:AA" & .Range("B" & Rows.Count).End(xlUp).Row + 1).ClearContents
        End With
    Next
    iIdx = 0
    Erase tData1
    For x = 0 To UBound(tData3, 2) - 1
        If sData = "" Then                                          'construction de la KEY
            sData = Trim(tData3(1, x)) & Trim(tData3(2, x))
        End If
        iFlag = 0
        If sData = Trim(tData3(1, x)) & Trim(tData3(2, x)) Then     'comparaison avec le tableau RESULTAT
            iIdx = iIdx + 1
            iFlag = 1
            If x = UBound(tData3, 2) - 1 Then iFlag = 0
            ReDim Preserve tData1(10, iIdx)
            For y = 0 To 9                                          'OK = enregistrement dans tData1 reconverti
                tData1(y, iIdx - 1) = tData3(y, x)
            Next
        End If
        If iFlag = 0 Then                                           'pas OK = inscription de tData1 dans la feuille TAD adéquate
            sSheet = .Cells(.Range("A5:A" & iRow).Find(what:=sData, lookat:=xlWhole, LookIn:=xlValues).Row, 5)
            With Worksheets(sSheet)
                .Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 2).Resize(iIdx, 10).Value = WorksheetFunction.Transpose(tData1)
            End With
            If x = UBound(tData3, 2) - 1 Then Exit For              'fin de RESULTAT, on sort sinon boucle sans fin (x=x-1)
            iIdx = 0
            Erase tData1
            sData = ""
            x = x - 1
        End If
    Next
    For x = 5 To iRow                                               'ajustement des colonnes au contenu des feuilles TAD
        With Worksheets(CStr(.Cells(x, 5)))
            .Columns("A:AA").AutoFit
        End With
    Next
End With

A+