Sub Déplacement()
Dim plage As Range, col%, tablo() As Boolean, i&, j%, c As Range
Set plage = [B5:AY34]
col = plage.Columns.Count
ReDim tablo(1 To plage.Rows.Count, 1 To col)
For i = 1 To UBound(tablo)
For j = 1 To col
If plage(i, j).Interior.ColorIndex = 4 Then tablo(i, j) = True
Next
Next
Application.ScreenUpdating = False 'accélère la macro
For i = 1 To UBound(tablo)
For j = 1 To col
If tablo(i, j) Then
If plage(i, j + 1) = "" Then
plage(i, j).Cut plage(i, j + 1) 'couper-coller
Else
Set c = plage.Columns(j + 1).Find("", , xlValues, xlWhole)
If Not c Is Nothing Then plage(i, j).Cut c
End If
End If
Next
Next
End Sub