Création de lien entre les données de deux feuilles

Sub Planning()
'
'
Dim Action As Variant 'Permet de stocker la valeur de l'action
Dim semaine As Integer 'Permet de stocker la date de l'action (si ce n'est pas un entier, il faut changer de type)
Dim couleur As Variant 'Permet de stocker la couleur de l'action
'Désactiver la mise à jour de l'écran
Application.ScreenUpdating = False

'suppression des données de Plan2
Sheets("Plan2").Select
Rows("6:30").Select 'les lignes 6 à 30 sont supprimées (augmenter si nécessaire)
Selection.Delete Shift:=xlUp
Cells(6, 1).Select

'sélection de la feuille des données de départ Plan_Proto
Sheets("Plan_Proto").Select

'sélection de la case de titre d'action
Cells(4, 7).Select

'Parcourir toute la liste des actions jusqu'à arriver à une case vide (normalement fin de la liste)
Do Until Selection.Value = ""

'sélection de la case en dessous pour passer à l'action suivante
Selection.Offset(1, 0).Select

'récupération des informations de l'action
Action = Selection.Value 'Récupération de la valeur de la case action
couleur = Selection.Interior.ColorIndex 'Récupération de la couleur de la case action
semaine = Selection.Offset(0, 37).Value 'Récupération de la la valeur de la semaine à droite de la case action

'sélection de la feuille du planning (Plan2)
Sheets("Plan2").Select

'sélection de la première date
Cells(5, 1).Select

'recherche de la semaine sur la Feuil7 de la colonne correspondante ou non trouvée
Do Until Selection.Value = semaine Or Selection.Value = ""
Selection.Offset(0, 1).Select
Loop

'Recherche de la première ligne vide
Do
Selection.Offset(1, 0).Select
Loop Until Selection.Value = ""

'copie de la valeur et de la couleur
Selection.Value = Action
Selection.Interior.ColorIndex = couleur

'sélection de la première date
Cells(5, 1).Select

'sélection de la feuille des données de départ (Feuil5)
Sheets("Plan_Proto").Select
Loop

'sélection de la feuille du planning (Feuil7)'pour visualiser le planning
Sheets("Plan2").Select

'Activer la mise à jour de l'écranApplication.ScreenUpdating = True

End Sub

Cliquez pour agrandir...