Discussion :

[jtsfab]

Bonjour ,

Pouvez vous m'aider à créer une macro ?

J'ai mis en pièce jointe un fichier avec plusieurs onglets .

Dans le 1er onglet BASE , on retrouve mon fichier de base avec en TO mon lien avec tous les autres onglets . Le but étant de récupérer les données des onglets AR, GR, AS,,OL et pouvoir les mettre dans le fichier base , afin de constater si sur un TO nous avons bien toutes les données et ainsi marqué en bout de tableau dans la colonne archiver , un OUI si nous avons tout et un NON si nous n' avons pas tout .
Bien évidement mes tableaux ont plus de colonne que cela .

J'ai fait ce fichier si cela est plus facile , mais en réalité chaque onglet est un fichier , que je viens remettre en un seul fichier . Mais si possible de récupérer les données sans faire cela , cela serait super .

j'ai essayé avec du recherche V , mais vu le nbre de ligne que j'ai pour chaque ficher , ca mouline a mort .

Si une âme charitable pouvait m' aider , ce serait génial

Merci d'avance

[EricDgn]

Bonjour,

Une façon de faire, plutôt que de faire des recherches, est de travailler sur des listes triées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub TrierCopier(sOnglet As String)
   With Worksheets(sOnglet).Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .SetRange Range("A:B")
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
   End With
   Worksheets(sOnglet).Columns("A:B").Copy Destination:=Sheets("BASE").Range("K1")  '--- K = colonne 11
End Sub

La comparaison se fait alors facilement par comparaison ligne à ligne des listes comme ceci par exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub RecupData(sOnglet As String, kC As Long)
   Dim kR1 As Long, kR2 As Long
   TrierCopier sOnglet
   Cells(1, kC) = Cells(1, 12)
   kR1 = 2
   kR2 = 2
   While Cells(kR1, 1) <> ""
      If Cells(kR1, 1) = Cells(kR2, 11) Then
         Cells(kR1, kC) = Cells(kR2, 12)
         kR1 = kR1 + 1
         kR2 = kR2 + 1
      ElseIf Cells(kR1, 1) < Cells(kR2, 11) Then
         '--- TO colonne A < TO colonne K
         kR1 = kR1 + 1
      Else
         '--- TO colonne A > TO colonne K => TO manquant
         Range(Cells(kR1, 1), Cells(kR1, 10)).Insert Shift:=xlDown
         Cells(kR1, 1) = Cells(kR2, 11)
         Cells(kR1, kC) = Cells(kR2, 12)
         kR1 = kR1 + 1
         kR2 = kR2 + 1
      End If
   Wend
End Sub

Bonne continuation.