Private Sub CommandButton9_Click()
'Selection de la feuille de Calcul 1
Worksheets("Feuil1").Select
Dim TableDep As Integer
Dim RangTableSuivante As Integer
Dim DecriTable As String
Dim Table As Integer
Dim Compteur As Integer
Dim NombreLignesTable As Integer
Dim NumMaxiTable As Integer
Dim LigneDepartTable As Integer
Dim LigneFinTable As Integer
Dim LigneTable As Integer
Dim Message As String
'*****************************************************
'Tri par Numéros de table
Selection.AutoFilter
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C2:C500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
' Placement du curseur en cellule C500
Range("C500").Select
'Recherche la dernière cellule renseignée colonne des tables : C
Selection.End(xlUp).Select
'MsgBox ("cellule active table Numéro le plus élevé" & ActiveCell.Address)
'Mettre dans la variable des boucles le numéro le plus élevé du nombre de tables
NumMaxiTable = ActiveCell.Value
'MsgBox (" Numéro plus élevé de table, Cellule active :" & NumMaxiTable)
'Descente à la cellule en dessous , rang table fictive
ActiveCell.Offset(1).Select
' Place un numéro fictif de table maxi égal à MaxiTable +1 sous la dernière cellule Maxi Table
ActiveCell.Value = NumMaxiTable + 1
'Adresse de la cellule fictive
'MsgBox ("Adresse Cellule fictive Numéro Table" & ActiveCell.Address)
'Mise en variable de l'adresse de la cellule table fictive
RangTableFictive = ActiveCell.Row
'*********************************************************
'Placement ec cellule C2 Colonne des tables
Range("C2").Select
Table = 1 ' Numéro de la première table
Etiquette1: 'Placement sur la cellule de la table suivante
'MsgBox ("Table :" & Table & " Compteur" & Compteur)
If Table = NumMaxiTable + 1 Then
'Effacement du numéro de table fictif placé sous le rang Maxi table
Cells(RangTableFictive, 3).Value = Clear
Exit Sub
'Descente à la cellule en dessous , rang table fictive
ActiveCell.Offset(1).Select
' Place un numéro fictif de table maxi égal à MaxiTable +1 sous la dernière cellule Maxi Table
ActiveCell.Value = NumMaxiTable + 1
End If
Compteur = 0
'TableDep contient le numéro de table de départ la boucle se faisant par une descente d'une ligne
TableDep = ActiveCell.Value
'Ligne de départ Table
LigneDepartTable = ActiveCell.Row
'MsgBox ("Table suivante :" & Table & " Compteur" & Compteur)
Do
'Descente à la cellule en dessous
ActiveCell.Offset(1).Select
Compteur = Compteur + 1
Table = ActiveCell.Value
'Nombre de lignes pour chaque table EN TENANT COMPTE QUE LE COMPTEUR EST SUR LA 1° LIGNE DE LA RABLE SUIVANTE --- donc Compteur -1
LigneFinTable = LigneDepartTable + Compteur - 1
' Pour le calcul du Nombres de lignes Table Le calcul doit prendre la ligne de la table suivante - la ligne de départ
NombreLignesTable = (LigneFinTable + 1) - LigneDepartTable
If Table = TableDep + 1 Then
'MsgBox ("Table départ en cours" & TableDep & " / " & " Table suivante" & Table)
' ATTENTION,NuméroTable en cours est la variable ( TableDep), puisque la boucle s'arrête sur la la ligne de la table en dessous
'DecriTable = "Numéro de la Table :" & TableDep & " - " & "Ligne de Départ Table :" & LigneDepartTable & " - " & "Ligne de fin de Table : " & LigneFinTable & " - " & "Nombre de lignes Table :" & NombreLignesTable
'MsgBox (DecriTable)
Dim Tableau (1 To 499)
For i = LigneDepartTable To LigneFinTable
Tableau(i) = Cells(i, 1).Value & " : " & Cells(i, 4).Value & " Personne (s) "
Next i
Message = ""
' Dans la Boucle suivante LigneFinTable correspond au numéro de la table suivante donc pour la bonne table modification en : LigneFinTable -1
For Boucle = LigneDepartTable To LigneFinTable
Message = Message & Tableau(Boucle) & vbLf
Next Boucle
'Else
'MsgBox ("ligne suivante de la même table N° " & Table & ": " & ActiveCell.Row)
End If ' ***de **** If Table = TableDep + 1 Then
Loop Until ActiveCell.Value = TableDep + 1
'MsgBox ("Table : " & TableDep & " /" & "Ligne Départ : " & LigneDepartTable & " /" & "Ligne fin :" & LigneFinTable & " /" & " Nombre Lignes Table : " & NombreLignesTable & " /" & "Nombre de Boucles effectuées : " & Boucle)
'MsgBox (Message)
For j = TableDep To NumMaxiTable
UserForm3.Controls("TextBox" & (TableDep)) = Message
Next j
UserForm3.Show
GoTo Etiquette1
End Sub
