Bonjour,
http://cjoint.com/?BEFn4bIwOQB
Sub Remplissage()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Sheets("Feuil1" ).Select
For k = 1 To 30000
For i = 1 To 30000
If Cells(i, 1) <> "" And Cells(i, 2) = "" Then
Range("C1" ) = Cells(i, 1)
Exit For
ElseIf Range("D1" ) = Range("E1" ) Then
Range("B:B" ).ClearContents
Range("C1" ).ClearContents
Range("D1" ).ClearContents
Exit Sub
Else
Cells(i + 1, 1).Select
End If
Next i
For j = 1 To 30000
If Cells(j, 1) = "" And Cells(j, 2) = "" Then
Cells(j, 1) = Range("C1" )
Cells(j, 2) = "X"
Range("D1" ) = Range("D1" ) + Cells(j, 1)
Cells(j + 1, 1).Select
ElseIf Cells(j, 1) <> "" And Cells(j, 2) = "" Then
Range("D1" ) = Range("D1" ) + Cells(j, 1)
Cells(j, 2) = "X"
Exit For
End If
Next j
Cells(k + 1, 1).Select
Next k
End Sub