Sub Transpose()
Dim a, b(), i As Long, j As Byte, x As Long, y As Byte
Application.ScreenUpdating = False
With Range("A2").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
For j = 1 To 2
x = x + 1
ReDim Preserve b(1 To 4, 1 To x)
For y = 1 To 4
Select Case y
Case 1, 2
b(y, x) = a(i, y)
Case 3
b(y, x) = a(1, j + 2)
Case 4
b(y, x) = a(i, j + 2)
End Select
Next
Next
Next
With .Offset(, .Columns.Count + 2)
.CurrentRegion.Clear
.Resize(, 4) = [{"Nom - Prénom", "Mat", "Type","Total"}]
.Offset(1).Resize(UBound(b, 2), UBound(b, 1)) = _
Application.Transpose(b)
With .CurrentRegion
.Offset(, 1).Resize(.Rows.Count, .Columns.Count - 1).HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround ColorIndex:=1, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Interior.ColorIndex = 36
.Columns(1).Interior.ColorIndex = 6
.Columns.AutoFit
With .Rows(1)
.RowHeight = 20
.BorderAround ColorIndex:=1, Weight:=xlThin
.Interior.ColorIndex = 44
.Font.Underline = xlUnderlineStyleSingle
.WrapText = True
End With
End With
End With
End With
Application.ScreenUpdating = True
End Sub