Re : Extraction de données dans cellules différentes
Sub Transfert()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Range("P2:X65536").ClearContents
For i = 2 To 65536
If Cells(i, 1) = "" Then Exit Sub
For j = 10 To 15
If Cells(i, j) <> "" Then
If Cells(i, 16) = "" And Cells(i, 17) = "" Then
Cells(i, 17) = Cells(i, j)
Cells(i, 16) = Cells(1, j)
ElseIf Cells(i, 18) = "" And Cells(i, 19) = "" Then
Cells(i, 19) = Cells(i, j)
Cells(i, 18) = Cells(1, j)
ElseIf Cells(i, 20) = "" And Cells(i, 21) = "" Then
Cells(i, 21) = Cells(i, j)
Cells(i, 20) = Cells(1, j)
ElseIf Cells(i, 22) = "" And Cells(i, 23) = "" Then
Cells(i, 23) = Cells(i, j)
Cells(i, 22) = Cells(1, j)
ElseIf Cells(i, 24) = "" And Cells(i, 25) = "" Then
Cells(i, 25) = Cells(i, j)
Cells(i, 24) = Cells(1, j)
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Ca à l'air de fonctionner comme ca