Recherche et copie de ligne
Bonjour les amis
Je tiens d'abord à vous remercier du travail que vous faites, j'ai appris pas mal de chose grace à vous sur VBA mais j'ai encore du mal avec cette fonction d'Excel
Aujourd'hui je face à un problème et je vous demande votre aide.
J'ai un fichier composé de deux onglets " Base de données" et l'autre " Recherche par entreprise" .
L'onglet " Base de données" comportent des informations sur plusieurs colonnes et j'aimerai que quand l'on écrit en céllule A1 de l'onglet " Recherche par entreprise" le nom d'une des entreprises qui se trouve en colonne B de l'onglet " Base de données", toutes les prestatares appartenant a cet entreprises ainsi que les informations de celui-ci qui sont dans les colonnes de A jusqu'a M soient copier dans l'onglet '' recherche par entreprise.
J'ai écris un code mais j'y suis pas encore et je joins aussi mon fichier .
Merci a vous
Sub find()
Application.ScreenUpdating = False
Range("B25:B" & Range("B65535").End(xlUp).Row + 1).ClearContents
For Each cellule In Sheets("Base de données").Range("B2:B" & Sheets("Base de données").Range("B65535").End(xlUp).Row)
If cellule = [A1] Then
Range("A" & Range("A65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 1)
Range("B" & Range("B65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 3)
Range("C" & Range("C65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 4)
Range("D" & Range("D65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 5)
Range("E" & Range("E65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 6)
Range("F" & Range("F65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 7)
Range("G" & Range("G65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 8)
Range("H" & Range("H65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 9)
Range("I" & Range("I65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 10)
Range("J" & Range("J65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 11)
Range("K" & Range("K65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 12)
Range("L" & Range("L65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 13)
Range("M" & Range("M65535").End(xlUp).Row + 1) = Sheets("Base de données").Cells(cellule.Row, 14)
End If
Next cellule
End Sub
Bonjour,
Je verrai bien le code de recherche de cette façon :
Sub Rechercher()
Dim Plage As Range
Dim Plage2 As Range
Dim Ligne As Range
Dim Cel As Range
Dim Adr As String
Dim NumLigne As Long
'vide les cellules de la feuille "Recherche par entreprise " à partir de A4. Attention, un espace parasite dans le nom de la feuille !!!
With Worksheets("Recherche par entreprise ")
.Range(.Cells(4, 1), .Cells( _
.Cells.find("*", .Cells(1, 1), -4123, , 1, 2).Row, _
.Cells.find("*", .Cells(1, 1), -4123, , 2, 2).Column)).Clear
End With
'défini la plage de recherche
With Worksheets("Base de données")
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
'commence la recherche...
Set Cel = Plage.find(Worksheets("Recherche par entreprise ").Cells(1, 1).Value, , xlValues, xlWhole)
'si trouvé...
If Not Cel Is Nothing Then
Adr = Cel.Address
Do
'défini la plage (en ligne) de valeurs
With Worksheets("Base de données")
Set Ligne = .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, .Cells(Cel.Row, .Columns.Count).End(xlToLeft).Column))
End With
'et recherche la première ligne vide dans la feuille "Recherche par entreprise " et inscrit les valeurs
With Worksheets("Recherche par entreprise ")
Set Plage2 = .Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, Ligne.Columns.Count))
Plage2.Value = Ligne.Value
End With
'continu la recherche...
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
End If
End Sub
Hervé.
Merci pour vos réponses rapides celle de Theze me convient bien sauf qu'a niveau j'ai deux problèmes , le 1er c'est au niveau de la restitution des colonnes, le copier coller n'était pas aux bonnes cases , j'ai reussi a modifier le code
Sub Trouver()
Application.ScreenUpdating = False
Dim WS1 As Worksheet
Dim Ws2 As Worksheet
Dim Trv
Set WS1 = Sheets("Base de données")
Set Ws2 = Sheets("Recherche par entreprise")
Ws2.Range("A1").Value = UCase(Ws2.Range("A1"))
Ws2.Select
Set Trv = [A1]
Ws2.Range("A4:M" & Range("A65535").End(xlUp).Row + 1).ClearContents
'Ws2.Range("A4:M" & Range("A65535").End(xlUp).Row + 1).Interior.ColorIndex = 3
For Each cellule In Sheets("Base de données").Range("B2:B" & Sheets("Base de données").Range("B65535").End(xlUp).Row)
If UCase(cellule) = Trv Then
Range("A" & Range("A65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 1)
Range("B" & Range("B65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 2)
Range("C" & Range("C65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 3)
Range("D" & Range("D65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 4)
Range("E" & Range("E65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 5)
Range("F" & Range("F65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 6)
Range("G" & Range("G65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 7)
Range("H" & Range("H65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 8)
Range("I" & Range("I65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 9)
Range("J" & Range("J65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 10)
Range("K" & Range("K65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 11)
Range("L" & Range("L65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 12)
Range("M" & Range("M65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 13)
End If
Next cellule
End Sub
Cependant malheureusement dans le cas ou j'ai une colonne qui n'est pas rempli il ne la prend pas en compte et j'aimerai qu'il considère qu'une colonne vide est une colonne ayant une information. Je sais pas si vous avez compris ce que je veux dire
Je te remercie beaucoup pour ton aide Hervé mais malheureusement j'ai pas compris ton code et j'aimerai par la suite pouvoir le modifier comme un grand et la j'avoue que je suis un peu perdu a la lecture de ton code
Bonjour,
De cette façon alors ? J'ai simplifié certaines lignes de code et ajouté des commentaires. Sache que la méthode Find() (qui est compilée) sera bien plus rapide qu'une boucle sur toutes les cellules de la plage :
Sub Rechercher()
Dim Plage As Range
Dim Ligne As Range
Dim Cel As Range
Dim Adr As String
'vide les cellules de la feuille "Recherche par entreprise " à partir de A4 jusqu'à M1000
Worksheets("Recherche par entreprise ").Range("A4:M1000").Clear
'défini la plage de recherche en colonne B de la feuille "Base de données" à partir de B2 à Bx...
With Worksheets("Base de données")
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
'commence la recherche dans la plage avec comme critère la valeur de la cellule A1 de la feuille "Recherche par entreprise "
'et par valeur exacte (xlWhole) et non partielle (xlPart)
Set Cel = Plage.find(Worksheets("Recherche par entreprise ").Cells(1, 1).Value, , xlValues, xlWhole)
'si trouvé...
If Not Cel Is Nothing Then
'mémorise l'adresse de la cellule afin de permettre l'arrêt de la recherche
Adr = Cel.Address
Do
'défini la plage (en ligne) de valeurs de la colonne A à la colonne M où a été trouvé la valeur en colonne B
With Worksheets("Base de données"): Set Ligne = .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, 13)): End With
'puis recherche la première ligne vide dans la feuille "Recherche par entreprise " et inscrit ces valeurs à partir de la colonne A
With Worksheets("Recherche par entreprise ")
.Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, Ligne.Columns.Count)) = Ligne.Value
End With
'continu la recherche tant que les adresses sont différentes...
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
End If
End Sub
Hervé.
Bonjour à tous
Une autre approche, plus difficile à expliquer mais qui permet un résultat extrêmement rapide, ce qui peut être intéressant si la Base de données est très grosse.
Bye !
C'est parfait je vous remercie les amis vous m'avez sauver d'une enorme galère
J'ai une dernière question les amis, dans le cas ou je souhaiterais que mon copier coller se face sur des colonnes discontinues par exemple de A jusqu'a C puis de F jusqu'a M comment dois-je faire ? j'ai écris ce code mais il ne fonctionnne pas
Sub Rechercher()
Dim Plage As Range
Dim Ligne As Range
Dim Cel As Range
Dim Adr As String
'vide les cellules de la feuille "Recherche par entreprise " à partir de A4 jusqu'à M1000
Worksheets("Recherche par entreprise").Range("A4:M1000").Clear
'défini la plage de recherche en colonne B de la feuille "Base de données" à partir de B2 à Bx...
With Worksheets("Base de données")
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
'commence la recherche dans la plage avec comme critère la valeur de la cellule A1 de la feuille "Recherche par entreprise "
'et par valeur exacte (xlWhole) et non partielle (xlPart)
Set Cel = Plage.Find(Worksheets("Recherche par entreprise").Cells(1, 1).Value, , xlValues, xlWhole)
'si trouvé...
If Not Cel Is Nothing Then
'mémorise l'adresse de la cellule afin de permettre l'arrêt de la recherche
Adr = Cel.Address
Do
'défini la plage (en ligne) de valeurs de la colonne A à la colonne M où a été trouvé la valeur en colonne B
With Worksheets("Base de données"): Set Ligne = .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, 3), .Cells(Cel.Row, 7 .Cells(Cel.Row, 13)): End With
End With
'puis recherche la première ligne vide dans la feuille "Recherche par entreprise " et inscrit ces valeurs à partir de la colonne A
With Worksheets("Recherche par entreprise")
.Range(.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, Ligne.Columns.Count)) = Ligne.Value
End With
'continu la recherche tant que les adresses sont différentes...
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
End If
End Sub
Bonjour,
ceci à la place peut être :
Set Ligne = .Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13))
debug.print ligne.Address ' pour voir l'adresse de la plage "LIGNE"
' appuies sur CTRL G pour voir l'effet de debug.print !!!
patrick1957 a écrit :Bonjour,
ceci à la place peut être :
Set Ligne = .Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13))
debug.print ligne.Address ' pour voir l'adresse de la plage "LIGNE"
' appuies sur CTRL G pour voir l'effet de debug.print !!!
En mettant
Set Ligne = .Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13))
il me prend de la la colonne A jusqu'a M mais moi je veux qu'il me prenne de A jusqu'a C puis de F jusqu'a M
Bonjour les amis j'utlise ce code
Sub Trouver()
Application.ScreenUpdating = False
Dim WS1 As Worksheet
Dim Ws2 As Worksheet
Dim Trv
Set WS1 = Sheets("Base de données")
Set Ws2 = Sheets("Recherche par entreprise")
Ws2.Range("A1").Value = UCase(Ws2.Range("A1"))
Ws2.Select
Set Trv = [A1]
Ws2.Range("A4:M" & Range("A65535").End(xlUp).Row + 1).ClearContents
'Ws2.Range("A4:M" & Range("A65535").End(xlUp).Row + 1).Interior.ColorIndex = 3
For Each cellule In Sheets("Base de données").Range("B2:B" & Sheets("Base de données").Range("B65535").End(xlUp).Row)
If UCase(cellule) = Trv Then
Range("A" & Range("A65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 1)
Range("B" & Range("B65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 2)
Range("C" & Range("C65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 3)
Range("D" & Range("D65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 4)
Range("E" & Range("E65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 5)
Range("F" & Range("F65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 6)
Range("G" & Range("G65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 7)
Range("H" & Range("H65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 8)
Range("I" & Range("I65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 9)
Range("J" & Range("J65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 10)
Range("K" & Range("K65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 11)
Range("L" & Range("L65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 12)
Range("M" & Range("M65535").End(xlUp).Row + 1) = WS1.Cells(cellule.Row, 13)
End If
Next cellule
End Sub
et je me rends compte que quand la boucle tombe sur une cellule vide, elle ne copie collle pas la cellule en question pour y mettre un "vide" mais elle copie colle la cellule juste en dessous ce qui fait un décalage dans la restitution de mes données. vous avez une idée du pourquoi du coment s'il vous plait ??