Sur un classeur : "Donn=E9es", 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=E9es".
Je souhaiterais avoir une macro qui va dans le classeur "Donn=E9es"
copier toutes les lignes dont la colonne A a les m=EAmes =E9l=E9ments que
ceux de la colonne A du classeur "suivi", et les coller en face des
renregistrements correspondants du classeur "suivi". Exemple :
Classeur "Donn=E9es" :
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
........
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
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.
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 :
0811cbe6-ea1d-402e-8b2d-b82669a33789@2g2000vbl.googlegroups.com...
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
........
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
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
Merci MichD. J'ai fais un test sur un exemple. Ca marche !.. Bravo. Demain je testerai grandeur nature. Bonne nuit.
MichD
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 '--------------------------------
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
'--------------------------------
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 '--------------------------------