Discussion :

[Petit Rasta]

Bonjour,

J'aurais besoin de votre aide pour adapter la macro suivant :

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
Option Explicit
 
Sub recap2()
Dim Sources, Champs, oSrc, oEqu
Dim i&, j&, k&, uoEqu2&, uChamps1&, uChamps2&
'
   With Sheets("RECAP2") 'Feuille de destination
      Sources = Array("Feuil9", "Feuil10", "Feuil11") 'Données à regrouper
      Champs = .Range("A1").Resize(1, .Range("A1").End(xlToRight).Column).Value 'Intitulés des champs de la feuille RECAP1
      Champs = WorksheetFunction.Transpose(Champs)
      uChamps1 = UBound(Champs, 1)
      For i = 0 To UBound(Sources)
         oSrc = Sheets(Sources(i)).Range("A1").CurrentRegion.Value
         ReDim oEqu(1 To 2, 1 To 1)
         For j = 1 To UBound(oSrc, 2)
            For k = 1 To uChamps1
               If oSrc(1, j) = Champs(k, 1) Then
                  ReDim Preserve oEqu(1 To 2, 1 To 1 + UBound(oEqu, 2))
                  oEqu(1, UBound(oEqu, 2)) = k
                  oEqu(2, UBound(oEqu, 2)) = j
               End If
            Next k
         Next j
         uoEqu2 = UBound(oEqu, 2)
         For j = 2 To UBound(oSrc, 1)
            ReDim Preserve Champs(1 To uChamps1, 1 To 1 + UBound(Champs, 2))
            uChamps2 = UBound(Champs, 2)
            For k = 2 To uoEqu2
               Champs(oEqu(1, k), uChamps2) = oSrc(j, oEqu(2, k))
            Next k
         Next j
      Next i
      Champs = WorksheetFunction.Transpose(Champs)
      .Range("A1").Resize(.Rows.Count, uChamps1).ClearContents
      .Range("A1").Resize(uChamps2, uChamps1).Value = Champs
   End With
End Sub

J'atteins la limite de la fonction, j'ai plus 80 000 lignes à traiter.
J'ai pu voir qu'il y avait des solutions pour ne pas utiliser cette fonction, notamment avec un array à 2D mais je n'ai pas très bien compris comment l'utiliser.

Merci par avance pour votre aide

[kiki29]

Salut, de la lecture ici