Couper/coller avec sélection d'un mot vers un autre onglet

Bonjour à tous,

je reviens vers vous car j'ai à nouveau besoin d'un coup de pouce.

J'ai adapté une macro à mes besoins mais qu'il y a une erreur que je n'arrive pas à résoudre sur la ligne:

                Set F = Worksheets("Recensement")

Je souhaite couper les lignes de la colonne F de la feuille SANNER vers la feuille RECENSEMENT mais le code ci dessous comporte une erreur et je ne trouve pas la solution.

Y aura t il une ame charitable? je n'en doute pas.

Sub Couperdata()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne As Long
    'On définit les mots clés
    MotCle = Array("recensement")
    'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("SANNER").Columns(6).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
                'On définit le nom de la feuille où sera effectuée la copie
                Set F = Worksheets("Recensement")
                With Worksheets(F)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    C.EntireRow.Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    C.EntireRow.Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
End Sub

A vous lire.

Merci d'avance.

Bonjour

Déclarer F en worksheet et non en string :

Dim F As Worksheet

Bonne soirée

Je viens de faire le test, cela fonctionne mais une nouvelle ligne est en erreur:

                    C.EntireRow.Copy .Range("A" & Ligne)

Peut être une autre idée?

A vous lire.

Bonsoir

Vois ce code

Sub Couperdata()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne, lg As Long
    'On définit les mots clés
    MotCle = Array("recensement")
    'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("SANNER").Columns(6).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
               lg = C.Row
                'On définit le nom de la feuille où sera effectuée la copie
                Set F = Worksheets("Recensement")
                With Worksheets(F)
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    Worksheets("SANNER").Rows(lg).Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    Worksheets("SANNER").Rows(lg).Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
End Sub

Dis-moi

A+

Merci Patty5046,

mais le problème reste le même sur la ligne:

                Set F = Worksheets("Recensement")

J'ai aussi fait le test en déclarant Dim F As Worksheets.

A vous lire

Bonjour

Dim F As Worksheet

et non pas Worksheets

A+

Bonjour et merci Patty5046 pour l'aide.

le code de la macro est, après correction:

Sub Couperdata()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As Worksheet
Dim Ligne, lg As Long
    'On définit les mots clés
    MotCle = Array("recensement")
    'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
    For i = 0 To UBound(MotCle)
        Do
            Set C = Worksheets("SANNER").Columns(6).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
            'Si le mot clé est trouvé
            If Not C Is Nothing Then
               lg = C.Row
                'On définit le nom de la feuille où sera effectuée la copie
                Set F = Worksheets("Recensement")
                With F
                    'On définit la ligne où sera effectué le collage
                    Ligne = .Range("F" & Rows.Count).End(xlUp).Row + 1
                    'On effectue le copier / coller
                    Worksheets("SANNER").Rows(lg).Copy .Range("A" & Ligne)
                    'On supprime la ligne dans la sheet1
                    Worksheets("SANNER").Rows(lg).Delete
                End With
            End If
        Loop While Not C Is Nothing
    Next i
End Sub

Affaire résolue mais je vais revenir car je vais reprendre mon projet d'une autre façon.

Je vais surement avoir besoin d'aide.