Macro pour automatiser traitement

[dehlio]

Bonjour,

N'arrivant pas à me dépatouiller, je fais appel à votre expertise.

Le fichier joint montre exactement ce que je veux faire.

Je reçois une extraction assez volumineuse toutes les semaines (type onglet "source") et je souhaiterais automatiser la création des onglets 1, 2 et 3 avec dans chaque onglet uniquement certaines lignes et certaines colonnes spécifiques du fichier source.

Les colonnes à reprendre sont les mêmes pour tous les onglets à créer (C,F,Q,R,U,V et AO du fichier source)

les lignes (donc références) à reprendre dans chaque onglet sont figées (cf exemple)

J'espère que ma demande est claire et pas trop compliquée, merci par avance si une âme charitable se penche sur mon problème,

Adiou,

 

[ROGER2327]

Re : Macro pour automatiser traitement

Bonjour dehlio

Essayez cette formule en B2 des feuilles 1, 2, 3 :

[COLOR="DarkSlateGray"][B]=SI($A2="";"";SI(INDEX(Source!$A:$AO;EQUIV($A2;Source!$C:$C;0);EQUIV(B$1;Source!$1:$1;0))="";"";INDEX(Source!$A:$AO;EQUIV($A2;Source!$C:$C;0);EQUIV(B$1;Source!$1:$1;0))))[/B][/COLOR]

à recopier à droite et vers le bas autant que de besoin.

Il faut évidemment que les références recherchées dans les feuilles 1, 2, 3 existent dans la feuille Source, ce qui n'est pas le cas dans votre classeur d'exemples.​

ROGER2327
#3891

Hunyadi 29 Gidouille 137 (hunyadi gras - Nom d'Ubu, SS)
25 Messidor An CCXVIII
2010-W28-2T22:50:00Z

 

[croco40]

Re : Macro pour automatiser traitement

Salut Dehlio,
Si j'ai bien tout compris, tu rentre manuellement les references en colonne A des 3 onglets.
Si c'est bien ç voici la macro.
Tu selectionne la feuille sur laquelle tu veux la mise à jour, pui tu fais outils => Macro => Macro => maj
Et il fera la mise a jour pour la feuille active.
Suerte
Croco
Je vais me coucher

 

[ROGER2327]

Re : Macro pour automatiser traitement

Bonjour croco40

Une solution par une procédure écrite en VBA est effectivement intéressante dans ce genre de problème.
Je propose deux variantes de votre procédure :

[COLOR="DarkSlateGray"][B]Sub maj2()
Dim i&, j&, var1
   With Sheets("Source")
      For i = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
         var1 = CStr(ActiveSheet.Cells(i, 1).Value)
         For j = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If var1 = .Cells(j, 3).Value Then
               ActiveSheet.Cells(i, 2).Value = .Cells(j, 6).Value
               ActiveSheet.Cells(i, 3).Value = .Cells(j, 17).Value
               ActiveSheet.Cells(i, 4).Value = .Cells(j, 18).Value
               ActiveSheet.Cells(i, 5).Value = .Cells(j, 21).Value
               ActiveSheet.Cells(i, 6).Value = .Cells(j, 22).Value
               ActiveSheet.Cells(i, 7).Value = .Cells(j, 41).Value
               Exit For
            End If
         Next j
      Next i
   End With
End Sub[/B][/COLOR]

car il suffit de lire tous les champs d'un enregistrement seulement lorsque la référence est trouvée.

[COLOR="DarkSlateGray"][B]Sub maj3()
Dim i&, j&, k&, var1, ch()
   ch = Array(3, 6, 17, 18, 21, 22, 41)
   With Sheets("Source")
      For i = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
         var1 = CStr(ActiveSheet.Cells(i, 1).Value)
         For j = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If var1 = .Cells(j, ch(0)).Value Then
               For k = 1 To UBound(ch)
                  ActiveSheet.Cells(i, k + 1).Value = .Cells(j, ch(k)).Value
               Next k
               Exit For
            End If
         Next j
      Next i
   End With
End Sub[/B][/COLOR]

qui est un peu plus facile à maintenir puisqu'il suffit de modifier la ligne

[COLOR="DarkSlateGray"][B]ch = Array(3, 6, 17, 18, 21, 22, 41)[/B][/COLOR]

si l'on décide de sélectionner d'autres champs.

Enfin, une procédure faisant le travail de la formule que je proposais hier :

[B][COLOR="DarkSlateGray"]Sub maj4()
Dim i&, j&, k&, var1, ch()
   With Sheets("Source")
      With .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
         For i = 1 To ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
            var1 = CStr(ActiveSheet.Cells(1, i).Value)
            For j = 1 To .Columns.Count
               If var1 = .Cells(1, j).Value Then
                  k = k + 1
                  ReDim Preserve ch(1 To 2, 1 To k)
                  ch(1, k) = i
                  ch(2, k) = j
                  Exit For
               End If
            Next j
         Next i
      End With
      For i = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
         var1 = CStr(ActiveSheet.Cells(i, ch(1, 1)).Value)
         For j = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If var1 = .Cells(j, ch(2, 1)).Value Then
               For k = 2 To UBound(ch, 2)
                  ActiveSheet.Cells(i, ch(1, k)).Value = .Cells(j, ch(2, k)).Value
               Next k
               Exit For
            End If
         Next j
      Next i
   End With
End Sub[/COLOR][/B]

Cette procédure est nettement plus souple car elle permet que les champs extraits dans les feuilles 1, 2, 3 ne soient ni nécessairement les mêmes, ni nécessairement dans le même ordre.
La seule contrainte est que le champ de recherche (Référence) soit la colonne A des feuilles 1, 2, 3.
Autrement dit, il n'est plus besoin d'intervenir sur le code même si on change les champs à extraire. Il suffit d'écrire le nom des champs dans la ligne 1, les références dans la colonne A et d'exécuter la procédure.​

ROGER2327
#3893

Dimanche 1er Tatane 137 (Fête du Père Ubu (Ubu d'été), SPs)
26 Messidor An CCXVIII
2010-W28-3T08:10:24Z

 

[dehlio]

Re : Macro pour automatiser traitement

merci à vous deux, croco40 et Roger2327, pour vos réponses rapides, de plus que vos propositions répondent exactement à ce que je voulais.

encore merci et à bientôt,

++