[COLOR="DarkSlateGray"][B]Sub tata()
Dim i As Long, j As Long
i = 2
j = 4
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do Until IsEmpty(Sheets("Base").Cells(i, 1))
If IsDate(Sheets("Base").Cells(i, 1)) Then
Sheets("Résultat").Cells(j, 1) = Sheets("Base").Cells(i, 1)
Sheets("Résultat").Cells(j, 2) = Sheets("Base").Cells(i, 1).Offset(1, 1)
Sheets("Résultat").Cells(j, 3) = Sheets("Base").Cells(i, 1).Offset(1, 2)
Sheets("Résultat").Cells(j, 4) = Sheets("Base").Cells(i, 1).Offset(1, 3)
i = i + 1
j = j + 1
End If
i = i + 1
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/B][/COLOR]