Private Sub CommandButton1_Click()
Dim Lg As Long ' Variable définissant le n° de ligne sur la feuille Recap
Range("B8:B65536").ClearContents ' Vide les cellules en colonne B, Feuille Recap
Lg = 8 ' Définit la ligne de départ pour inserion des références en colonne B, Feuille Recap
' Lit en boucle les n° de semaines sur la feuille Adresse
' La lecture commence en ligne 4 et s'arrête sur la dernière cellule remplie dans la colonne A
For Each cel In Sheets("Adresses").Range("A4:A" & Sheets("Adresses").Range("A65536").End(xlUp).Row)
' Si le N° de semaine correspond à la cellule B5
If cel.Value = Range("B5").Value Then
' On ajoute la référence à la ligne
Cells(Lg, 2) = Sheets("Adresses").Cells(cel.Row, 2)
' et on fixe la position de la ligne suivante
Lg = Lg + 1
End If
Next
' Appel de la macro de mise à jour/création des feuilles
Courriers
End Sub
Sub Courriers()
' RefCourrier contient la référence du courrier
' ListCourrier contient les noms des feuilles déjà présentes dans le classeur
Dim RefCourrier As String, ListCourriers As String
' LRef contient le n° de ligne de la référence trouvée
Dim LRef As Long
' Trouve détermine si une feuille est existante ou pas
Dim Trouve As Boolean
Application.DisplayAlerts = False ' Empêche l'affichage des messages sytème
ListCourriers = ""
' Balayage des feuilles existantes dans le classeur
For Each sh In Sheets
' Si la feuille n'est pas dans la liste, on l'y ajoute (avec une virgule de séparation
If InStr(ListCourriers, sh.Name) = 0 Then ListCourriers = ListCourriers & sh.Name & ","
Next
' Balayage de la colonne B, lignes 8 à dernière ligne remplie
For Each cel In Range("B8:B" & Range("B65536").End(xlUp).Row)
RefCourrier = cel.Value ' Affecte la valeur de la cellule lue à la variable RefCourrier
If InStr(ListCourriers, RefCourrier) > 0 Then
' Si RefCourrier est dans la liste
Trouve = True ' Trouve = vrai
' Affiche la boîte de message Courrier existant
rep = MsgBox("Le courrier " & RefCourrier & " existe déjà !" & vbCrLf & "Voulez-vous le remplacer ?", vbYesNo + vbQuestion, "COURRIER EXISTANT")
Else
Trouve = False ' Sinon Trouve = faux
End If
If rep = vbNo Then GoTo Suite ' Si on a répondu Non à la boîte de dialogue, on boucle à la cellule suivante
' Si on a répondu Oui
' Et si Trouve = vrai, alors on supprime la feuille existante
If Trouve = True Then Sheets(RefCourrier).Delete
' Copie et place en dernière position la feuille Courrier Type
Sheets("Courrier Type").Copy After:=Sheets(Sheets.Count)
' Affiche la feuille Récap
Sheets("Recap").Activate
' Toutes les actions suivantes se font sur la feuille qui vient d'être copiée
With Sheets(Sheets.Count)
' Renomme la feuille
.Name = RefCourrier
' Cherche la référence dans la colonne B de la feuille Adresses
Set Ref = Sheets("Adresses").Range("B:B").Find(RefCourrier, LookIn:=xlValues, lookat:=xlWhole)
' Si la référence est trouvée
If Not Ref Is Nothing Then
' On recupère son n° de ligne
LRef = Ref.Row
' Et on recopie les données dans les cellules de la feuille qui vient d'être copiée
.Range("C18") = Sheets("Adresses").Cells(LRef, 2)
.Range("G7") = Sheets("Adresses").Cells(LRef, 3)
.Range("G8") = Sheets("Adresses").Cells(LRef, 4)
.Range("G9") = Sheets("Adresses").Cells(LRef, 5)
.Range("G10") = Sheets("Adresses").Cells(LRef, 6)
.Range("G11") = Sheets("Adresses").Cells(LRef, 7) & " " & Sheets("Adresses").Cells(LRef, 8)
End If
End With
Suite:
Next cel
Application.DisplayAlerts = True ' Rétablit l'affichage des messages sytème
End Sub
