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.
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.
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.
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.
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
--------------------------------------------