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