bonsoir,
en parcourant le Forum, j'ai trouvé un code proposé par Oracle7 et amélioré para ROGER2327 D'AVRIL 2010, qui peut s'adapter à mes besoins, si ce n'est qu'il me faut importer 5 COLONNES de donnees parmis 15 existantes, maisd'un seul onglet situé dans des fichiers differents, mais dans le même classeur, de l'onglet Recap.
Les colonnes importées sont toujours dans le même ordre mais pas dans un ordre sequentiel dans le fichier de la base de données.
[/QUOTE]Sub recap()
Dim Sources, Champs, oSrc, oEqu
Dim i&, j&, k&, uoEqu2&, uChamps1&, uChamps2&
'
With Sheets("RECAP") 'Feuille de destination
Sources = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4", "Feuil5") 'Données à regrouper
Champs = .Range("A1").Resize(1, .Range("A1").End(xlToRight).Column).Value 'Intitulés des champs de la feuille RECAP
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
Si quelqu'un peut m'aider je le remercie para avance
cordialement
gilles
en parcourant le Forum, j'ai trouvé un code proposé par Oracle7 et amélioré para ROGER2327 D'AVRIL 2010, qui peut s'adapter à mes besoins, si ce n'est qu'il me faut importer 5 COLONNES de donnees parmis 15 existantes, maisd'un seul onglet situé dans des fichiers differents, mais dans le même classeur, de l'onglet Recap.
Les colonnes importées sont toujours dans le même ordre mais pas dans un ordre sequentiel dans le fichier de la base de données.
[/QUOTE]Sub recap()
Dim Sources, Champs, oSrc, oEqu
Dim i&, j&, k&, uoEqu2&, uChamps1&, uChamps2&
'
With Sheets("RECAP") 'Feuille de destination
Sources = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4", "Feuil5") 'Données à regrouper
Champs = .Range("A1").Resize(1, .Range("A1").End(xlToRight).Column).Value 'Intitulés des champs de la feuille RECAP
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
Si quelqu'un peut m'aider je le remercie para avance
cordialement
gilles