Transformation d'un format tableau en un autre

Option Explicit

Sub test()
Dim r As Range, rng As Range, derlig As Long
Dim i As Long, j As Byte, n As Long
    Application.ScreenUpdating = False
    Sheets("Feuil1").Cells.Clear
    With Sheets("LIVRAISON TRANSPORT")
        n = 1: derlig = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 4 To derlig
            Set rng = .Range(.Cells(i, 1), .Cells(i, 31))
            With rng.Offset(, 1).Resize(, rng.Columns.Count - 1)
                On Error Resume Next
                Set r = .RowDifferences(.Find("", lookat:=xlWhole))
                On Error GoTo 0
            End With
            If Not r Is Nothing Then
                With Sheets("Feuil1")
                    For j = 1 To r.Areas.Count
                        n = n + 1
                        .Cells(n, 1) = rng.Cells(1).Value
                        .Cells(n, 2) = r.Areas(j)(3 - i, 1)
                        r.Areas(j).Copy
                        .Cells(n, 3).PasteSpecial xlPasteValues
                    Next
                End With
            End If
            Set r = Nothing
        Next
        With Sheets("Feuil1").Cells(1)
            .Resize(1, 8).Value = Array("Usine", "Jour", "S", _
                                        "Propriétaire", "Chantier", "T", "Prod", "V. (st)")
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                With .Rows(1)
                    .BorderAround Weight:=xlThin
                    .Interior.ColorIndex = 38
                End With
                .Columns.AutoFit
            End With
            .Parent.Activate
        End With
    End With
    Set rng = Nothing
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub