Sub transpose()
Dim a, b(), i As Long, j As Long, k As Long, n As Long
Application.ScreenUpdating = False
a = Sheets("Data").Range("A7").CurrentRegion.Value
ReDim b(1 To UBound(a, 1) * (UBound(a, 2) - 2), 1 To 4)
For i = 2 To UBound(a, 1)
For j = 3 To UBound(a, 2)
n = n + 1
For k = 1 To 2
b(n, k) = a(i, k)
Next
b(n, 3) = a(1, j)
b(n, 4) = a(i, j)
Next
Next
With Sheets("Feuil1").Cells(1)
.CurrentRegion.Clear
.Resize(, 4).Value = [{"Geo","Geo","Année","Population"}]
.Offset(1).Resize(n, 4).Value = b
With .CurrentRegion
With .Rows(1)
.Interior.ColorIndex = 44
.BorderAround Weight:=xlThin
End With
.Font.Name = "calibri"
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
.Columns.AutoFit
End With
End With
Application.ScreenUpdating = True
End Sub