Sub SpecialTransfert()
Dim MonTab, TabFin, i As Long, x As Long, j As Byte
With Worksheets("Feuil1")
MonTab = .Range("C10:J13")
ReDim TabFin(1 To UBound(MonTab) * 4, 1 To 8)
For i = LBound(MonTab) To UBound(MonTab)
For j = 1 To 4
x = x + 1
TabFin(x, 1) = MonTab(i, 2)
TabFin(x, 2) = MonTab(i, 1)
If j = 1 Then
TabFin(x, 3) = "C" & MonTab(i, 3)
TabFin(x, 7) = MonTab(i, 8)
Else
TabFin(x, 3) = Cells(7 + j, 13)
If j = 4 Then
TabFin(x, 8) = MonTab(i, 3 + j)
Else
TabFin(x, 8) = MonTab(i, 2 + j)
End If
End If
TabFin(x, 4) = MonTab(i, 3)
Next
Next
.Range("O27").Resize(UBound(TabFin, 1), UBound(TabFin, 2)) = TabFin
End With
End Sub
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
Euh ... un doute m'étreint: tu connais la poignée de recopie, tout de même? (ce petit carré noir à l'angle inférieur droit d'une sélection)sans faire de copier-coller