Déplacer une ligne entière vers une section de feuille précise

Bonjour,

Tout d'abord je tiens à préciser que mes connaissances en VBA sont très limités et que je commence tout juste à apprendre à ce sujet


Voici mon problème :

J'ai présentement deux feuilles - Sheet 1 et Sheet 2

Le première contient des tâches qui ne sont pas encore affectées à un employé.

La deuxième contient les tâches affectées selon chacun des employés. Par exemple, les tâches affectées à l'employé A commence à partir de la ligne 10 et les tâches affectées à l'employé B commence à partir de la ligne 20.

J'aimerais donc qu'à chaque fois que l'on affecte une tâche à un employé dans la feuille 1 (en indiquant son nom dans la colonne C) que la ligne se supprime et se transfère automatiquement vers la section attitrée à l'employé dans la feuille 2.

J'arrive à effectuer le transfert d'une feuille à l'autre. Cependant, je n'arrive pas à ce que le transfert débute selon une section précise pour chacun des employés. Existe-t-il un moyen d'effectuer ceci?

Voici le code que j'ai tenté d'implanter :

Sub test()

    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Employé A" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A1" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Employé A" Then
                K = K - 1
            End If
            J = J + 1
        End If
        If CStr(xRg(K).Value) = "Employé B" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A2" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Employé B" Then
                K = K - 1
            End If
            J = J + 1
        End If
        If CStr(xRg(K).Value) = "Employé C" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A3" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Employé C" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Merci de votre aide !

Bonjour Utilisateur_VBA et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment :

  • Joignez (si possible) un fichier pour augmenter vos chances d'obtenir de l'aide en cliquant sur le bouton Fichier de l'éditeur. Si votre fichier est trop lourd ou contient des données personnelles, créez une version allégée de votre fichier avec juste assez d'informations pour permettre de comprendre votre problème. Dans tous les cas, ne postez JAMAIS de fichiers avec des informations personnelles ou confidentielles (cet utilitaire peut vous aider à les retirer).

Je vous invite à regarder également les fonctionnalités du Nouveau Forum

Merci de votre participation

Cordialement

Rechercher des sujets similaires à "deplacer ligne entiere section feuille precise"