Hotel réservation excel

Sub Bookings()
    'declare the variables
    Dim bCell As Range, Rm As Range, Dt As Range, orange As Range
    Dim dCell As Range, aCell As Range, Cl As Range, Nn As Range, ID As Range
    Dim Fws As Worksheet, Bws As Worksheet
    Dim x As Integer
    Dim lastrow As Long
    Dim oCell As Variant
    Dim iCell As Variant
    Dim DerLgn As Integer 'Ici
    On Error Resume Next 
    'variables
    Set Fws = Sheet4 'data sheet
    Set Bws = Sheet2 'bookings sheet 
    'filter the data to limit
    FilterRng
    'set the range to loop through
    lastrow = Fws.Range("AJ" & Rows.Count).End(xlUp).Row
    Set orange = Fws.Range("AJ9:AJ" & lastrow)
    'clear the values from the calendar
     With Bws 'Ici
      DerLgn = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 'Ici
            .Range("E13:BH" & DerLgn).ClearContents 'Ici
            .Range("E13:BH" & DerLgn).Interior.ColorIndex = xlNone 'Ici
     End With 'Ici
    'LOOP 1"""""""""""""""""""""""""""""""
    'set the variable for the number of rows and loop through
    For x = 13 To DerLgn 'Ici
        'set the room variable
        Set Rm = Bws.Cells(x, 3)     
        'LOOP 2"""""""""""""""""""""""""""""'
        'loop through column range
        For Each dCell In Bws.Range(Bws.Cells(x, 5), Bws.Cells(x, 60))
                If Not dCell Is Nothing Then
                'set the date variable
                Set Dt = Cells(12, dCell.Column)             
                'FIND FUNCTION""""""""""""""""""""
                'find the rooms
                Set aCell = orange.Find(What:=Rm, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                    If Not aCell Is Nothing Then
                    'set the room variable
                    Set bCell = aCell                 
                    'LOOP 3"""""""""""""""""""""""
                    'loop through the filtered data
                    Do
                    'find the next room with a booking
                    Set aCell = orange.FindNext(After:=aCell)
                    'establish the dates to add
                        If aCell.Offset(0, 1).Value <= Dt.Value And aCell.Offset(0, 3).Value >= Dt.Value Then
                            'set the variables
                            Set Cl = aCell.Cells(1, 5) 'status
                            Set Nn = aCell.Cells(1, 10) 'name
                            Set ID = aCell.Offset(0, -1) 'ID                         
                            'add the names and reassign after once
                            If oCell <> Nn Or iCell <> ID Then
                                dCell.Value = Nn
                                Set oCell = Nn
                                Set iCell = ID
                            End If                         
                            'add the coloring
                            Select Case Cl
                                Case "Unconfirmed"
                                dCell.Interior.ColorIndex = 27
                                Case "Confirmed"
                                dCell.Interior.ColorIndex = 24
                                Case "Paid"
                                dCell.Interior.ColorIndex = 4
                                Case "Cancelled"
                                dCell.Interior.ColorIndex = 38
                            End Select
                        End If
                'exit when values are found
                    If Not aCell Is Nothing Then
                        If aCell.Address = bCell.Address Then Exit Do
                        Else
                            Exit Do
                        End If
                    '"""""""""""
                    Loop 'LOOP 3 end
                    '"""""""""""""""""""""""""""
                    End If
                End If
            '""""""""""'
        Next dCell 'LOOP 2 end
        '"""""""""""""
    Next x 'LOOP 1 end
    '"""""""""""""""
    On Error GoTo 0
End Sub