Bonjour à tous.

J'ai besoin de votre aide. Je souhaite attribuer des chambres à un groupe de personnes.

Les chambres sont renseignées dans la feuille "Chambres". Dans cette feuille, la colonne C permet de programmer la place des chambre entre 1, 2 et 3 personnes à prendre en compte dans l'attribution.
Il y a 4 plages de chambres selon les profils des personnes déterminés par le groupe et par le genre (F ou G).

L'attribution s'effectue dans la feuille "Attribution" de A3 à G69. La liste des personnes est présente dans la feuille "Attribution" de P3 à U69. La liste peut changer avec les données en conséquence (formations, groupes...).
Ainsi, les colonne A,B et C sont des données copiées de la feuille "Chambres", tandis que les colonnes D,E,F et G sont remplies par la copies des cellules respectives suivantes : P,R,Q et U (donc on retrouve en en D la valeur de P et en F la valeur de Q...).
En toute logique, une chambre est attribuable qu'une seule fois (à faire comprendre à excel).
Enfin, j'aimerais qu'il soit considéré des préférences qui sont inscrite dans la feuille "Preferences" avec des personnes à mettre ensemble si possible et à séparer obligatoirement (toutes les lignes ne concernent pas la présente attribution).

Vous me seriez d'une grande aide car je suis très limité et chat gpt n'y arrive pas et fait des erreurs qui se trouve dans la macro ci-après. En fonction de ce qui est souhaité, il faudrait la compléter
Je tente ma chance ici auprès de la communauté des pro.

MERCI D'AVANCE POUR LE TEMPS QUE VOUS Y CONSACREREZ.
Fichier attribution.xlsm

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Sub AttribuerChambres()
    Dim wsAttribution As Worksheet
    Dim wsChambres As Worksheet
    Dim rngPersonnes As Range
    Dim rngChambres As Range
    Dim personne As Range
    Dim ligne As Long
    Dim chambreDisponible As Boolean
    Dim cell As Range ' Déclaration de la variable cell
 
    ' Définir les feuilles de calcul
    Set wsAttribution = ThisWorkbook.Sheets("Attribution")
    Set wsChambres = ThisWorkbook.Sheets("Chambres")
 
    ' Définir la plage de données des personnes
    Set rngPersonnes = wsAttribution.Range("P3:Z69")
 
    ' Parcourir chaque personne dans la plage de personnes
    For Each personne In rngPersonnes.Rows
        ' Vérifier si la ligne est vide
        If Application.CountA(personne) > 0 Then
            ' Réinitialiser le marqueur de chambre disponible
            chambreDisponible = False
 
            ' Vérifier les valeurs en P et U pour définir la plage de chambres
            If (personne.Cells(1, 16).Value = "Grp2!$A$8" Or personne.Cells(1, 16).Value = "Grp2!$A$9" Or personne.Cells(1, 16).Value = "Grp2!$A$10") And personne.Cells(1, 21).Value = "F" Then
                Set rngChambres = wsChambres.Range("A3:A69")
            ElseIf (personne.Cells(1, 16).Value = "Grp2!$A$8" Or personne.Cells(1, 16).Value = "Grp2!$A$9" Or personne.Cells(1, 16).Value = "Grp2!$A$10") And personne.Cells(1, 21).Value = "G" Then
                Set rngChambres = wsChambres.Range("F3:F69")
            ElseIf (personne.Cells(1, 16).Value = "Grp2!$A$3" Or personne.Cells(1, 16).Value = "Grp2!$A$4" Or personne.Cells(1, 16).Value = "Grp2!$A$5" Or personne.Cells(1, 16).Value = "Grp2!$A$6" Or personne.Cells(1, 16).Value = "Grp2!$A$7" Or personne.Cells(1, 16).Value = "Grp2!$A$11" Or personne.Cells(1, 16).Value = "Grp2!$A$12" Or personne.Cells(1, 16).Value = "Grp2!$A$13" Or personne.Cells(1, 16).Value = "Grp2!$A$14" Or personne.Cells(1, 16).Value = "Grp2!$A$15" Or personne.Cells(1, 16).Value = "Grp2!$A$16" Or personne.Cells(1, 16).Value = "Grp2!$A$17" Or personne.Cells(1, 16).Value = "Grp2!$A$18" Or personne.Cells(1, 16).Value = "Grp2!$A$19" Or personne.Cells(1, 16).Value = "Grp2!$A$20" Or personne.Cells(1, 16).Value = "Grp2!$A$21" Or personne.Cells(1, 16).Value = "Grp2!$A$22" Or personne.Cells(1, 16).Value = "Grp2!$A$23" Or personne.Cells(1, 16).Value = "Grp2!$A$24" Or personne.Cells(1, 16).Value = "Grp2!$A$25") And personne.Cells(1, 21).Value = "F" Then
                Set rngChambres = wsChambres.Range("K3:K69")
            ElseIf (personne.Cells(1, 16).Value = "Grp2!$A$3" Or personne.Cells(1, 16).Value = "Grp2!$A$4" Or personne.Cells(1, 16).Value = "Grp2!$A$5" Or personne.Cells(1, 16).Value = "Grp2!$A$6" Or personne.Cells(1, 16).Value = "Grp2!$A$7" Or personne.Cells(1, 16).Value = "Grp2!$A$11" Or personne.Cells(1, 16).Value = "Grp2!$A$12" Or personne.Cells(1, 16).Value = "Grp2!$A$13" Or personne.Cells(1, 16).Value = "Grp2!$A$14" Or personne.Cells(1, 16).Value = "Grp2!$A$15" Or personne.Cells(1, 16).Value = "Grp2!$A$16" Or personne.Cells(1, 16).Value = "Grp2!$A$17" Or personne.Cells(1, 16).Value = "Grp2!$A$18" Or personne.Cells(1, 16).Value = "Grp2!$A$19" Or personne.Cells(1, 16).Value = "Grp2!$A$20" Or personne.Cells(1, 16).Value = "Grp2!$A$21" Or personne.Cells(1, 16).Value = "Grp2!$A$22" Or personne.Cells(1, 16).Value = "Grp2!$A$23" Or personne.Cells(1, 16).Value = "Grp2!$A$24" Or personne.Cells(1, 16).Value = "Grp2!$A$25") And personne.Cells(1, 21).Value = "G" Then
                Set rngChambres = wsChambres.Range("P3:P69")
            End If
 
            ' Vérifier si rngChambres est défini et s'il contient des cellules
            If Not rngChambres Is Nothing Then
                If rngChambres.Cells.count > 0 Then
                    ' Parcourir chaque cellule dans la plage de chambres
                    For Each cell In rngChambres
                        ' Vérifier si la cellule contient une chambre disponible et non en travaux
                        If cell.Value <> "" And cell.Offset(0, 3).Value <> "en travaux" Then
                            ' Vérifier si la chambre a des places disponibles
                            If cell.Offset(0, 2).Value <> "2 places seulement" Then
                                ' Vérifier si la chambre n'a pas déjà été attribuée dans 3 lignes précédentes
                                ligne = personne.Row - 1
                                If Application.WorksheetFunction.CountIf(wsAttribution.Range("A3:A" & ligne), cell.Value) < 3 Then
                                    ' Attribuer les informations dans les colonnes A à G de la feuille "Attribution"
                                    With wsAttribution
                                        .Cells(personne.Row, 4).Value = cell.Value ' Numéro de chambre
                                        .Cells(personne.Row, 2).Value = cell.Offset(0, 1).Value ' Bâtiment
                                        .Cells(personne.Row, 3).Value = cell.Offset(0, 2).Value ' Copie de la donnée en B,G,L,Q selon les critères
                                        .Cells(personne.Row, 1).Value = personne.Cells(1, 16).Value ' Donnée en P
                                        .Cells(personne.Row, 5).Value = personne.Cells(1, 18).Value ' Donnée en R
                                        .Cells(personne.Row, 6).Value = personne.Cells(1, 17).Value ' Donnée en Q
                                        .Cells(personne.Row, 7).Value = personne.Cells(1, 21).Value ' Donnée en U
                                    End With
                                    ' Marquer la chambre comme attribuée
                                    chambreDisponible = True
                                    ' Sortir de la boucle car la chambre a été attribuée
                                    Exit For
                                End If
                            End If
                        End If
                    Next cell
 
                    ' Vérifier si aucune chambre n'a été attribuée
                    If Not chambreDisponible Then
                        ' Afficher un message d'avertissement
                        MsgBox "Aucune chambre disponible correspondant aux critères pour la personne à la ligne " & personne.Row, vbExclamation, "Aucune chambre disponible"
                    End If
                Else
                    MsgBox "La plage de chambres est vide.", vbCritical, "Erreur de plage de chambres"
                End If
            Else
                MsgBox "La plage de chambres n'est pas définie.", vbCritical, "Erreur de plage de chambres"
            End If
        End If
    Next personne
End Sub