RE
Ce que j'ai conseillé en VBA. Voir aussi le sremarques sur la feuille Util.
N.B. : j'ai mis ton code en commentaires. Tu peux rétablir Workbook (je n'ai pas détaillé) mais je te conseille de voir autrement Worksheet_Change de Service car plage limitée et non basée sur le listobject et réction permanent inappropriée...
Sub CHGT()
Dim changement As Range, NewChambre As Range, Permut As String, Ordre, C_O As String
Set changement = Range("Tableau13[Changement de Chambre]").Find(What:="*", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If changement Is Nothing Then Exit Sub
Permut = changement.Offset(0, -8).Text
Set NewChambre = Range("Tableau13[Chambre]").Find(What:=changement.Value, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
NewChambre.Value = Permut
Set NewChambre = Range("Tableau13[Chambre]").Find(What:=Permut, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
NewChambre.Value = changement.Value
With Worksheets("Util").ListObjects("Ordre").DataBodyRange
ReDim Ordre(.Cells.Count, 1)
Ordre = .Cells.Value
End With
For I = 1 To UBound(Ordre)
C_O = C_O & """" & Ordre(I, 1) & """" & IIf(I < UBound(Ordre), ";", "")
Next I
changement.ClearContents
With Worksheets("Service").ListObjects("Tableau13").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Tableau13[Chambre]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, CustomOrder:=(C_O), DataOption:=xlSortNormal
.MatchCase = False
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
.SortFields.Clear
End With
End Sub