Faire deplacer des tableau sur la droite...

Option Explicit

Sub Déplacement()
    Range("K4:S10").Copy Range("X4")
    Range("J13:R23").Copy Range("X13")
    Range("I26:Q32").Copy Range("X26")
    Range("H35:P45").Copy Range("X35")
    Range("B4").Select
End Sub

=SI(NB.VIDE($A4:$K4)>10;"";INDEX($A$4:$S$46;LIGNE()-3;NB.VIDE($A4:$K4)+COLONNES($A:A)+1))

Sub Mettre_en_forme()
Dim n&, c As Range, lig&, col%
n = Application.CountIf(Cells, "Crs.")
If n = 0 Then Exit Sub 'sécurité
Application.ScreenUpdating = False
For n = 1 To n
  Set c = Cells.Find("Crs.", IIf(c Is Nothing, [A1], c), xlValues)
  lig = Cells(c.Row, "B").CurrentRegion.Rows.Count
  c.CurrentRegion.Resize(lig).Cut Cells(c.Row, "C")
  col = Application.Max(col, c.CurrentRegion.Columns.Count)
Next
Columns("C").Resize(, col).AutoFit 'ajustement  de la largeur
Range(Columns("C").Offset(, col), Columns(Columns.Count)).Delete
[C2].MergeArea.Borders.Weight = xlThin 'si nécessaire
End Sub

Sub Mettre_en_forme()
Dim n&, c As Range, lig&, col%
n = Application.CountIf(Cells, "Crs.")
If n = 0 Then Exit Sub 'sécurité
Application.ScreenUpdating = False
For n = 1 To n
  Set c = Cells.Find("Crs.", IIf(c Is Nothing, [A1], c), xlValues)
  lig = Cells(c.Row, "B").CurrentRegion.Rows.Count
  If c.Column > 3 Then c.CurrentRegion.Resize(lig).Cut Cells(c.Row, "C")
  col = Application.Max(col, c.CurrentRegion.Columns.Count)
Next
Columns("C").Resize(, col).AutoFit 'ajustement  de la largeur
Range(Columns("C").Offset(, col), Columns(Columns.Count)).Delete
[C2].MergeArea.Borders.Weight = xlThin 'si nécessaire
End Sub

=SI(NB.VIDE($A4:$K4)>9;"";INDEX($A$4:$S$98;LIGNE()-3;NB.VIDE($A4:$J4)+COLONNES($A:A)+1))

Sub Mettre_en_forme()
Dim P As Range, n&, col%, c As Range, c1 As Range, lig&
Set P = ActiveSheet.UsedRange
n = Application.CountIf(Cells, "N°")
If n = 0 Then Exit Sub 'sécurité
Application.ScreenUpdating = False
col = P.Column + P.Columns.Count
For n = 1 To n
  If c Is Nothing Then Set c = Cells.Find("N°", , xlValues, , xlByRows) _
    Else Set c = P.Find("N°", c)
  Set c1 = Rows(c.Row).Find("Crs.", c)
  If Not c1 Is Nothing Then
    lig = c.CurrentRegion.Rows.Count
    c.Resize(lig).Copy Cells(c.Row, col) 'facultatif
    c1.Resize(lig, col - c1.Column).Cut Cells(c.Row, col + 1)
  End If
Next
Range(Columns(col), Columns(Columns.Count)).AutoFit 'ajustement largeur
End Sub

'c.Resize(lig).Copy Cells(c.Row, col) 'facultatif

For i = 1 To Sheets.Count
For Each cellule In Sheets(i).Range("U6:AH" & Range("U65535").End(xlUp).Row)
If cellule <> "" Then Sheets(i).Cells(cellule.Row, cellule.Column + 19) = cellule
Next cellule
Next i