trouver puis extraire

Le
Sylian
Bonjour les pros !

J'ai une petite macro qui malheureusement n'a pas son effet voulu.
J'ai une feuille 1 (fl1) avec près de 19000 lignes (sur une 20aine de
colonne)
J'ai une feuille 2 avec une liste d'environ 1200 nom en colonne A

Le but de ma macro est de générer un tableau en feuille3 (fl2) en
reprenant mes 1200 noms de la feuille 2 et en les complétant avec la
ligne entière quand il existe une correspondance avec le tableau de
donnée en feuille 1. Petite info supplémentaire : je cherche chaque mot
de la feuille2/colonneA (sheets(2))dans la feuille1/colonneB (fl1)(ça
serait trop simple sinon lol)

Voici ma routine qui plante à mon grand désespoir :

--

Sub correspondance()

Set fl1 = Sheets(1)
Nvligne = 1


' insere une nouvelle feuille de réslutat

vNomFeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vNomFeuille
Set fl2 = Worksheets(vNomFeuille)

'Cherche et extrait

Application.ScreenUpdating = False

For Each c In Sheets(2).Range("A1:A" & [A20000].End(xlUp).Row)

Set Cherch = fl1.Range("B5:B" & [B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)

If Not Cherch Is Nothing Then
Cherch.EntireRow.Copy fl2.Cells(nvLigne, 1)
Nvligne = Nvligne + 1
End If
Next c
Set Cherch = Nothing

End Sub

--



Merci d'avance pour le coup de pouce !
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
isabelle
Le #6741601
bonjour Sylian,

c'est possible de faire cela avec une formule,
mettre cette formule sur la feuille fl2 en cellule B1
et recopier à droite

=INDEX(fl1!B:B;EQUIV($A1;fl1!$A:$A;0))

isabelle

Bonjour les pros !

J'ai une petite macro qui malheureusement n'a pas son effet voulu.
J'ai une feuille 1 (fl1) avec près de 19000 lignes (sur une 20aine de
colonne)
J'ai une feuille 2 avec une liste d'environ 1200 nom en colonne A

Le but de ma macro est de générer un tableau en feuille3 (fl2) en
reprenant mes 1200 noms de la feuille 2 et en les complétant avec la
ligne entière quand il existe une correspondance avec le tableau de
donnée en feuille 1. Petite info supplémentaire : je cherche chaque mot
de la feuille2/colonneA (sheets(2))dans la feuille1/colonneB (fl1)(ça
serait trop simple sinon lol)

Voici ma routine qui plante à mon grand désespoir :

-----------------------------

Sub correspondance()

Set fl1 = Sheets(1)
Nvligne = 1


' insere une nouvelle feuille de réslutat

vNomFeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vNomFeuille
Set fl2 = Worksheets(vNomFeuille)

'Cherche et extrait

Application.ScreenUpdating = False

For Each c In Sheets(2).Range("A1:A" & [A20000].End(xlUp).Row)

Set Cherch = fl1.Range("B5:B" & [B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)

If Not Cherch Is Nothing Then
Cherch.EntireRow.Copy fl2.Cells(nvLigne, 1)
Nvligne = Nvligne + 1
End If
Next c
Set Cherch = Nothing

End Sub

-----------------------------



Merci d'avance pour le coup de pouce !


Sylian
Le #6741581
Merci de l'astuce Isabelle.
J'y avais pensé également à l'aide d'un ChercheV mais il y a trop de
ligne à extraire et comparer. la modification d'une cellule demande un
recalcule long et fastidieux. Je préfère m'orienter vers une Macro.

Une autre idée ?


bonjour Sylian,

c'est possible de faire cela avec une formule,
mettre cette formule sur la feuille fl2 en cellule B1
et recopier à droite

=INDEX(fl1!B:B;EQUIV($A1;fl1!$A:$A;0))

isabelle

Bonjour les pros !

J'ai une petite macro qui malheureusement n'a pas son effet voulu.
J'ai une feuille 1 (fl1) avec près de 19000 lignes (sur une 20aine de
colonne)
J'ai une feuille 2 avec une liste d'environ 1200 nom en colonne A

Le but de ma macro est de générer un tableau en feuille3 (fl2) en
reprenant mes 1200 noms de la feuille 2 et en les complétant avec la
ligne entière quand il existe une correspondance avec le tableau de
donnée en feuille 1. Petite info supplémentaire : je cherche chaque
mot de la feuille2/colonneA (sheets(2))dans la feuille1/colonneB
(fl1)(ça serait trop simple sinon lol)

Voici ma routine qui plante à mon grand désespoir :

-----------------------------

Sub correspondance()

Set fl1 = Sheets(1)
Nvligne = 1


' insere une nouvelle feuille de réslutat

vNomFeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vNomFeuille
Set fl2 = Worksheets(vNomFeuille)

'Cherche et extrait

Application.ScreenUpdating = False

For Each c In Sheets(2).Range("A1:A" & [A20000].End(xlUp).Row)

Set Cherch = fl1.Range("B5:B" & [B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)

If Not Cherch Is Nothing Then
Cherch.EntireRow.Copy fl2.Cells(nvLigne, 1)
Nvligne = Nvligne + 1
End If
Next c
Set Cherch = Nothing

End Sub

-----------------------------



Merci d'avance pour le coup de pouce !




isabelle
Le #6742061
bonjour Sylian,

voilà :

Sub Macro1()
For i = 1 To Sheets("fl2").Range("A65536").End(xlUp).Row
On Error Resume Next
Set trouve = Range("A" & Application.Match(Sheets("fl2").Range("A" & i), Sheets("fl1").Range("A:A"), 0))
'test = trouve.Row
If Not trouve Is Nothing Then
For y = 2 To 10
Sheets("fl2").Cells(i, y) = Sheets("fl1").Cells(trouve.Row, y)
Next
End If
Next
End Sub

isabelle

Merci de l'astuce Isabelle.
J'y avais pensé également à l'aide d'un ChercheV mais il y a trop de
ligne à extraire et comparer. la modification d'une cellule demande un
recalcule long et fastidieux. Je préfère m'orienter vers une Macro.

Une autre idée ?


bonjour Sylian,

c'est possible de faire cela avec une formule,
mettre cette formule sur la feuille fl2 en cellule B1
et recopier à droite

=INDEX(fl1!B:B;EQUIV($A1;fl1!$A:$A;0))

isabelle

Bonjour les pros !

J'ai une petite macro qui malheureusement n'a pas son effet voulu.
J'ai une feuille 1 (fl1) avec près de 19000 lignes (sur une 20aine de
colonne)
J'ai une feuille 2 avec une liste d'environ 1200 nom en colonne A

Le but de ma macro est de générer un tableau en feuille3 (fl2) en
reprenant mes 1200 noms de la feuille 2 et en les complétant avec la
ligne entière quand il existe une correspondance avec le tableau de
donnée en feuille 1. Petite info supplémentaire : je cherche chaque
mot de la feuille2/colonneA (sheets(2))dans la feuille1/colonneB
(fl1)(ça serait trop simple sinon lol)

Voici ma routine qui plante à mon grand désespoir :

-----------------------------

Sub correspondance()

Set fl1 = Sheets(1)
Nvligne = 1


' insere une nouvelle feuille de réslutat

vNomFeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vNomFeuille
Set fl2 = Worksheets(vNomFeuille)

'Cherche et extrait

Application.ScreenUpdating = False

For Each c In Sheets(2).Range("A1:A" & [A20000].End(xlUp).Row)

Set Cherch = fl1.Range("B5:B" & [B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)

If Not Cherch Is Nothing Then
Cherch.EntireRow.Copy fl2.Cells(nvLigne, 1)
Nvligne = Nvligne + 1
End If
Next c
Set Cherch = Nothing

End Sub

-----------------------------



Merci d'avance pour le coup de pouce !






Fredo P
Le #6742021
Sub correspondance()

Set fl1 = Feuil1
Nvligne = 1
' insere une nouvelle feuille de réslutat
vnomfeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
If IsError(Sheets(vnomfeuille).Activate) Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vnomfeuille
End If
'Cherche et extrait
Set fl2 = Worksheets(vnomfeuille)
Application.ScreenUpdating = False
For Each c In fl2.Range("A1:A" & [A20000].End(xlUp).Row)
If c <> "" Then
Set Cherch = fl1.Range("B1:B" & fl1.[B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)
If Not Cherch Is Nothing Then ' c.value
Cherch.EntireRow.Copy fl2.Cells(Nvligne, 1)
Nvligne = Nvligne + 1
End If
End If
Next c
Set Cherch = Nothing

End Sub

Fredo P.
Sylian
Le #6747511
Re-bonjour

Merci à toi Fredo et Isabelle mais aucune de vos deux autres solutions
ne fonctionne. L'une me génère des messages d"erreur et l'autre ne
recopie rien du tout. J'ai essayé de les bidouiller mais sans succès :(
(je suis trop mauvais)

Voici un exemple de ce que je voudrais faire :
http://cjoint.com/?fFsCV5h1Np
En considérant que la feuille 3 est le résultat de la macro.

Merci beaucoup d'avance !



Sub correspondance()

Set fl1 = Feuil1
Nvligne = 1
' insere une nouvelle feuille de réslutat
vnomfeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
If IsError(Sheets(vnomfeuille).Activate) Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vnomfeuille
End If
'Cherche et extrait
Set fl2 = Worksheets(vnomfeuille)
Application.ScreenUpdating = False
For Each c In fl2.Range("A1:A" & [A20000].End(xlUp).Row)
If c <> "" Then
Set Cherch = fl1.Range("B1:B" & fl1.[B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)
If Not Cherch Is Nothing Then ' c.value
Cherch.EntireRow.Copy fl2.Cells(Nvligne, 1)
Nvligne = Nvligne + 1
End If
End If
Next c
Set Cherch = Nothing

End Sub

Fredo P.




Fredo P
Le #6748431
Ça doit convenir.
http://cjoint.com/?fFwrFU4cBB
Sub correspondance()
Dim fl1, Cherch As Range, fl2, c As Object, Nvligne&, vnomfeuille$
On Error Resume Next
Set fl1 = Feuil1
Nvligne = 1
' insere une nouvelle feuille de réslutat
vnomfeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
If IsError(Sheets(vnomfeuille).Activate) Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vnomfeuille
End If
'Cherche et extrait
Set fl2 = Worksheets(vnomfeuille)
Application.ScreenUpdating = False
For Each c In Feuil2.Range("A1:A" & Feuil2.[A20000].End(xlUp).Row)
If c <> "" Then
Set Cherch = fl1.Range("B1:B" & fl1.[B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)
If Not Cherch Is Nothing Then ' c.value
Cherch.EntireRow.Copy fl2.Cells(Nvligne, 1)
Nvligne = Nvligne + 1
End If
End If
Next c
Set Cherch = Nothing

End Sub

Fredo P.
Sylian
Le #6755041
Ça doit convenir.
http://cjoint.com/?fFwrFU4cBB
Sub correspondance()
Dim fl1, Cherch As Range, fl2, c As Object, Nvligne&, vnomfeuille$
On Error Resume Next
Set fl1 = Feuil1
Nvligne = 1
' insere une nouvelle feuille de réslutat
vnomfeuille = Trim(InputBox("Nom de la nouvelle feuille à intégrer"))
If IsError(Sheets(vnomfeuille).Activate) Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vnomfeuille
End If
'Cherche et extrait
Set fl2 = Worksheets(vnomfeuille)
Application.ScreenUpdating = False
For Each c In Feuil2.Range("A1:A" & Feuil2.[A20000].End(xlUp).Row)
If c <> "" Then
Set Cherch = fl1.Range("B1:B" & fl1.[B20000].End(xlUp).Row).Find(What:=c,
LookIn:=xlValues, LookAt:=xlWhole)
If Not Cherch Is Nothing Then ' c.value
Cherch.EntireRow.Copy fl2.Cells(Nvligne, 1)
Nvligne = Nvligne + 1
End If
End If
Next c
Set Cherch = Nothing

End Sub

Fredo P.





Mille mercis Fredo !
J'ai adapté ta formule pour mes feuilles et données persos et après un
peu de travail : ça marche !!!
Merci pour l'aide, cela va épargner de longues heures de recherche et de
copier/coller à tout va.

@bientôt

Sylian

Publicité
Poster une réponse
Anonyme