Sub Transfert()
Dim a, b(), i As Long, n As Long, j As Byte
With Sheets("Feuil1")
With .Range("C9").CurrentRegion.Resize(, 11)
a = Application.Index(.Value, Evaluate("row(1:" & _
.Rows.Count & ")"), Array(2, 1, 3, 8, 4, 5, 7, 10, 11))
End With
ReDim b(1 To 100, 1 To 8)
For i = 2 To UBound(a, 1)
For j = 4 To UBound(a, 2) - 2
n = n + 1
b(n, 1) = a(i, 1)
b(n, 2) = a(i, 2)
Select Case j
Case 4
b(n, 3) = "C" & a(i, 3)
Case 5
b(n, 3) = a(1, 9)
Case 6
b(n, 3) = a(2, 9)
Case 7
b(n, 3) = a(3, 9)
End Select
b(n, 4) = a(i, 3)
b(n, 7) = IIf(j = 4, a(i, 4), "")
b(n, 8) = IIf(j = 4, "", a(i, j))
Next
Next
.Range("C28").Resize(n, UBound(b, 2)) = b
End With
End Sub