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,

un essai:

P.

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

Rechercher des sujets similaires à "recherche copie ligne"