Creation Macro

Bonjour tout le monde,

Je suis novice dans pour la mise en place d'une macro Excel 2010. Je souhaiterai votre aide s'il vous plait.

voici mon problème, dans mon fichier Excel, j'ai Feuillet 1 et Feuillet 2.

Feuillet 1 contient les informations suivante :

B1 =Text 1

B2 =Text 2

B3= Text 3

B4 =Text 4

B5 =Text 5

etc...

Je souhaite mettre en place une macro avec une variable qui parcourt l'ensemble de la colonne B du Feuille 1, si elle trouve dans une cellule le texte définit ci-dessus, elle copie toute la ligne dans Feuille 2 et au même niveau.

par exemple si elle trouve dans la cellule B3 le texte "Text 3", elle copie toute la ligne 3 à la ligne 3 du feuille 2.

D'avance merci à vous tous !

Cordialement,

ExcelNovices

bonsoir,

une proposition de macro

Sub copieligne()
    Set ws1 = Sheets("Feuil1")
    Set ws2 = Sheets("feuil2")
    Set ws3 = Sheets("feuil3")
    dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    dl3 = ws3.Cells(Rows.Count, "B").End(xlUp).Row
    For i = 1 To dl1
        Set re = ws3.Range("B1:B" & dl3).Find(ws1.Cells(i, "B"), lookat:=xlWhole)
        If re Is Nothing Then
        Else
            ws3.Rows(re.Row).Copy ws2.Rows(re.Row)
        End If
    Next i
End Sub

Bonjour,

Merci pour la réponse. mais ça ne marche pas comme je voulais. ça compile sans erreur. mais l'exécution ne fait rien.

En fait, je cherche un texte bien précis par exemple "Hello" dans les cellules de la colonne B de la feuille 1, si le texte est trouvé, il copie la ligne correspondante à la cellule "Hello" dans la feuille 2 et au même niveau.

D'avance merci !

Bonjour,

une proposition de correction

Sub copieligne()
    Set ws1 = Sheets("Feuil1")
    Set ws2 = Sheets("feuil2")
    b=inputbox("mot à rechercher")
    dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
with   ws1.Range("B1:B" & dl1)
        Set re = .Find(b, lookat:=xlpart)
        If re Is Nothing Then
        Else
           fa=re.address
           do
                 ws1.Rows(re.Row).Copy ws2.Rows(re.Row)
                 set re=.findnext(re)
           loop while re.address <> fa
        End If
end with
End Sub

Re-Bonjour,

Merci beaucoup "h2so4". Cà marche très bien.

Par contre est-il possible d'avoir le choix sur plusieurs mots à rechercher en le mettant dans un Case par exemple.

Sub copieligne()
    Dim Mot As String

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    'b = InputBox("mot à rechercher")
    Select Case Mot
        Case "Hello"
            dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
            With ws1.Range("B1:B" & dl1)
                Set re = .Find(Mot, lookat:=xlPart)
                If re Is Nothing Then
                Else
                    fa = re.Address
                    Do
                        ws1.Rows(re.Row).Copy ws2.Rows(re.Row)
                        Set re = .FindNext(re)
                    Loop While re.Address <> fa
                End If
            End With
        Case "France"
            dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
            With ws1.Range("B1:B" & dl1)
                Set re = .Find(Mot, lookat:=xlPart)
                If re Is Nothing Then
                Else
                    fa = re.Address
                    Do
                        ws1.Rows(re.Row).Copy ws2.Rows(re.Row)
                        Set re = .FindNext(re)
                    Loop While re.Address <> fa
                End If
            End With
    End Select
End Sub

Bonjour,

sur base de ce que j'ai compris ... à tester

Sub copieligne()
        Dim Mot 

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
                        dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
for each mot in array("Hello","France")
                        With ws1.Range("B1:B" & dl1)
                                Set re = .Find(Mot, lookat:=xlPart)
                                If re Is Nothing Then
                                Else
                                        fa = re.Address
                                        Do
                                                ws1.Rows(re.Row).Copy ws2.Rows(re.Row)
                                                Set re = .FindNext(re)
                                        Loop While re.Address <> fa
                                End If
                        End With
next
End Sub

edit : instruction Dim mot

Bonjour,

Merci h2so4 pour les indications, cependant ma macro n'est toujours pas au point. votre code précédent ne se compile pas. Par contre, j'ai modifié le code comme ci-dessous :

Sub copieligne()

    Dim Mot(0 To 30) As String
    Dim i As Integer

Mot(00) = "France00"
    Mot(01) = "France01"
    Mot(02) = "France02"
    Mot(03) = "France03"
    Mot(04) = "France04"
    Mot(05) = "France05"
    Mot(06) = "France06"
    Mot(07) = "France07"
    Mot(08) = "France08"
    Mot(09) = "France09"
    Mot(10) = "France10"
    Mot(11) = "France11"
    Mot(12) = "France12"
    Mot(13) = "France13"
    Mot(14) = "France14"
    Mot(15) = "France15"
    Mot(16) = "France16"
    Mot(17) = "France17"
    Mot(18) = "France18"
    Mot(19) = "France19"
    Mot(20) = "France20"
    Mot(21) = "France21"
    Mot(22) = "France22"
    Mot(23) = "France23"
    Mot(24) = "France24"
    Mot(25) = "France25"
    Mot(26) = "France26"
    Mot(27) = "France27"
    Mot(28) = "France28"
    Mot(29) = "France29"
    Mot(30) = "France30"

    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    for each i in Mot()
        With ws1.Range("B1:B" & dl1)
            Set re = .Find(Mot, lookat:=xlPart)
                If re Is Nothing Then
                    Else
                        fa = re.Address
                        Do
                            ws1.Rows(re.Row).Copy ws2.Rows(re.Row)
                            Set re = .FindNext(re)
                            Loop While re.Address <> fa
                         End If
        End With
    next i
End Sub

Au début, il m'affiche l'erreur suivante : " For Each control variable on arrays must be variant", en modifiant l'initialisation :

Dim i As Integer 

par

Dim i As Variant

, le code s'exécute sans erreur mais il recopie uniquement la ligne correspondante au mot "France00" et il ne fait pas la suite.

Merci de votre aide !!!

Cordialement,

ExcelNovices

re bonjour,

proposition de correction à tester

Sub copieligne()

        Dim Mot(0 To 30) As String
        Dim i 

Mot(00) = "France00"
        Mot(01) = "France01"
        Mot(02) = "France02"
        Mot(03) = "France03"
        Mot(04) = "France04"
        Mot(05) = "France05"
        Mot(06) = "France06"
        Mot(07) = "France07"
        Mot(08) = "France08"
        Mot(09) = "France09"
        Mot(10) = "France10"
        Mot(11) = "France11"
        Mot(12) = "France12"
        Mot(13) = "France13"
        Mot(14) = "France14"
        Mot(15) = "France15"
        Mot(16) = "France16"
        Mot(17) = "France17"
        Mot(18) = "France18"
        Mot(19) = "France19"
        Mot(20) = "France20"
        Mot(21) = "France21"
        Mot(22) = "France22"
        Mot(23) = "France23"
        Mot(24) = "France24"
        Mot(25) = "France25"
        Mot(26) = "France26"
        Mot(27) = "France27"
        Mot(28) = "France28"
        Mot(29) = "France29"
        Mot(30) = "France30"

        Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    dl1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
        for each i in Mot()
                With ws1.Range("B1:B" & dl1)
                        Set re = .Find(i, lookat:=xlPart)
                                If re Is Nothing Then
                                        Else
                                                fa = re.Address
                        Do
                                                        ws1.Rows(re.Row).Copy ws2.Rows(re.Row)
                            Set re = .FindNext(re)
                            Loop While re.Address <> fa
                         End If
        End With
    next i
End Sub
 
Rechercher des sujets similaires à "creation macro"