Sub TransposeLIG_COL()
Dim a As Variant, b As Variant
Dim i&, j&, k&
Dim t0 As Double
'Heure départ
t0 = Timer
Application.ScreenUpdating = False
' passage en calcul sur ordre
Application.Calculation = xlCalculationManual
'si error, on saute à FIN: pour remettre le calcul en automatique
On Error GoTo FIN
a = ActiveSheet.Cells(1).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)
k = k + 1
b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(1, j): b(k, 4) = a(i, j)
Next j
Next i
Sheets(2).Cells(1).Resize(UBound(b, 1), UBound(b, 2)).Value = b
FIN:
If Err.Number > 0 Then MsgBox "Erreur n° " & Err.Number & vbLf & Err.Description
Application.Calculation = xlCalculationAutomatic
MsgBox Format(Timer - t0, "0.0 \ sec."), vbInformation, "Temps éxécution macro"
'crédits code: Peter_SSs, ma pomme
End Sub
Sub CreationDonnees()
'macro pour générer des données de test
Application.ScreenUpdating = False
[C1] = 1: [A2:B2] = Array(100002, "DATA2")
[C1:N1].DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
[B2:B30000].DataSeries Rowcol:=xlColumns, Type:=xlAutoFill, Date:=xlDay, Trend:=False
[A2:A30000].DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
[C2:N30000] = "=RANDBETWEEN(1,500)": [C2:N30000] = [C2:N30000].Value
End Sub