extraire données

Le
arissam
Bonjour ;

Sur un classeur : "Données", j'ai un tableau de plusieurs lignes et
colonnes.
Sur un classeur : "Suivi", j'ai une colonne A qui reprend certains
enregistrements de la colonne A du classeur "Données".

Je souhaiterais avoir une macro qui va dans le classeur "Données"
copier toutes les lignes dont la colonne A a les mêmes éléments que
ceux de la colonne A du classeur "suivi", et les coller en face des
renregistrements correspondants du classeur "suivi". Exemple :

Classeur "Données" :

A B C D
1 a2 az op hg
2 d3 df rf tr
3 f4 hg ty jk
4 m2 sf df rt
5 ml ml op ui
..

Sur le classeur "Suivi":

A B C D
3 f4
5 ml
.

Merci pour votre aide.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #23255951
Bonjour,

Les 2 classeurs doivent être ouverts
J'ai supposé que dans les 2 classeurs les données étaient en Feuil1.
Il te faudra adapter le nom des feuilles le cas échéant.

'----------------------------------
Sub test()
Dim Rg As Range, Trouve As Range, Adr As String
Dim DerCol As Integer, Plg As Range, C As Range

'Je suppose que tes données sont dans la feuille "Feuil1")
With Workbooks("Données").Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End With

With Workbooks("Suivi").Worksheets("Feuil1")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Plg
x = Application.Match(C, Rg, 0)
If Not IsError(C) Then
C.Resize(, DerCol).Value = Rg(x).Resize(, DerCol).Value
End If
Next
End Sub
'----------------------------------



MichD
--------------------------------------------
"arissam" a écrit dans le message de groupe de discussion :


Bonjour ;

Sur un classeur : "Données", j'ai un tableau de plusieurs lignes et
colonnes.
Sur un classeur : "Suivi", j'ai une colonne A qui reprend certains
enregistrements de la colonne A du classeur "Données".

Je souhaiterais avoir une macro qui va dans le classeur "Données"
copier toutes les lignes dont la colonne A a les mêmes éléments que
ceux de la colonne A du classeur "suivi", et les coller en face des
renregistrements correspondants du classeur "suivi". Exemple :

Classeur "Données" :

A B C D...
1 a2 az op hg
2 d3 df rf tr
3 f4 hg ty jk
4 m2 sf df rt
5 ml ml op ui
........

Sur le classeur "Suivi":

A B C D
3 f4
5 ml
....

Merci pour votre aide.
MichD
Le #23255991
Oups, une erreur de frappe...

Cette ligne de code dans la procédure :

If Not IsError(C) Then

devrait être :

If Not IsError(x) Then

Et en début de procédure, tu peux déclarer la variable :
Dim X As variant


MichD
--------------------------------------------
arissam
Le #23256041
On 3 avr, 23:06, "MichD"
Oups, une erreur de frappe...

Cette ligne de code dans la proc dure :

If Not IsError(C) Then

devrait tre :

If Not IsError(x) Then

Et en d but de proc dure, tu peux d clarer la variable :
Dim X As variant

MichD
--------------------------------------------



Merci MichD. J'ai fais un test sur un exemple. Ca marche !.. Bravo.
Demain je testerai grandeur nature.
Bonne nuit.
MichD
Le #23256071
La procédure devrait se lire comme suit... après correction
dans la déclaration des variables :

'--------------------------------
Sub test()
Dim Rg As Range, X As Variant
Dim DerCol As Integer, Plg As Range, C As Range

'Je suppose que tes données sont dans la feuille "Feuil1")
With Workbooks("Données.xls").Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End With

With Workbooks("Suivi.xls").Worksheets("Feuil1")
Set Plg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Plg
X = Application.Match(C, Rg, 0)
If Not IsError(X) Then
C.Resize(, DerCol).Value = Rg(X).Resize(, DerCol).Value
End If
Next
End Sub
'--------------------------------

MichD
--------------------------------------------
Publicité
Poster une réponse
Anonyme