XL 2010 Analyse croisée sur 2 tableaux

[spike29]

Bonsoir,

Je bloque sur la construction d'un tableau d'analyse ayant pour source deux autres tableaux présents dans deux autres Feuil de mon classeurs.
Le tableau 1 se trouve dans la Feuil Variables1 et le tableau2 dans le Feuil Variables2.
Le résultat attendu de l'analyse doit se trouver dans le Feuil Résultats.

Etant très mauvais dans la construction de boucle, je bute totalement sur le sujet.

La condition :
Si une valeur de la colonne B du tableau présent dans la Feuil Variables2 est également présente dans la colonne A du tableau Feuil Variable1 alors lancer la séquence de copie de données vers la Feuil Résultats ( à partir de la cellule B26).

Séquence de copie :

Dans le tableau Feuil Variables2
Pour chaque lignes pour lesquelles la valeur colonne B est également présente dans la colonne A de la Feuil Variable1 alors copier vers Feuil Résultats :
Copier Cellules B (de la ligne concernée) Feuil Variables2 vers Cellules B Feuil Résultats ( à partir de la cellule B26)
Copier Cellules E:O (de la ligne concernée) Feuil Variables2 vers Cellules K:U Feuil Résultats ( à partir de la cellule K26)
Copier Cellules C (de la ligne concernée) Feuil Variables1 vers Cellules E:F Feuil Résultats ( à partir de la cellule E26)

Exemple du résultat attendu de la macro dans la Feuil "Résultat attendu".

La macro se déclenchera à partir du bouton Macro Feuil Analyses.

Pour mieux s'y retrouver j'ai mis un code couleurs dans les différentes colonnes des Feuils pour rapidement visualiser leurs correspondances pour la copie.

En espérant avoir été clair dans mon expression de besoin. N'hésitez pas si des points restent flous.

Je vous transmet le fichier en PJ.



Merci d'avance pour votre aide.

Bonne fin de journée

 

[jpb388]

Bonjour à tous
essayes ceci

Sub Macro1()
      Dim Cel As Range, Pl As Range, LgV1&, LgR&
      Set Pl = Feuil4.Range("B13:O" & Feuil4.Range("B" & Rows.Count).End(xlUp).Row)
       Feuil2.Range("B26:B" & Feuil2.Range("B" & Rows.Count).End(xlUp).Row).Clear
       LgR = 26
       Application.ScreenUpdating = False
      For Each Cel In Pl.Rows
            On Error Resume Next
            LgV1 = Feuil3.Range("A12:A" & Feuil3.Range("A" & Rows.Count).End(xlUp).Row).Find(Cel.Cells(1).Text).Row
            If Err.Number = 0 Then
                  With Feuil2
                        Feuil4.Range("B" & Cel.Row & ":D" & Cel.Row).Copy
                        .Range("B" & LgR & ":D" & LgR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Feuil4.Range("E" & Cel.Row & ":O" & Cel.Row).Copy
                        .Range("K" & LgR & ":U" & LgR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Feuil3.Range("C" & LgV1 & ":D" & LgV1).Copy
                        .Range("E" & LgR & ":F" & LgR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With
                  LgR = LgR + 1
            End If
            Err.Clear
      Next Cel
      With Feuil2.Range("B26:O" & LgR - 1)
            .BorderAround Weight:=xlThin
            .Borders(xlInsideHorizontal).Weight = xlThin
            .Borders(xlInsideVertical).Weight = xlThin
      End With
      Application.ScreenUpdating = True
End Sub

 

[spike29]

Bonsoir et désolé pour cette réponse tardive.
Votre code fonctionne parfaitement et répond complètement à mon besoin.
Avec en bonus la mise en forme automatique du tableau via les bordures.
Encore merci pour votre réponse !

Bonne fin de journée

Cdt,