'Recap de la feuille sélectionnée
Sub Recap1Feuille()
Dim wsRecap As Worksheet
Dim ws As Worksheet
Dim rg As Range, rgRecap As Range
Dim i As Byte
Application.ScreenUpdating = False
Set wsRecap = Sheets("P.Différés")
Set ws = ActiveSheet
If ws.Name <> wsRecap.Name Then '...sauf la feuille recap
Set rg = ws.Range("T3") 'cellule de départ
Do Until rg.Row = 122 'dernière ligne
If rg.Text <> "" Then 'ligne non vide
Set rgRecap = wsRecap.Range("A60000").End(xlUp).Offset(1, 0) 'ligne d'écriture
rgRecap = ws.Range("D1") 'jour
rg.Resize(1, 6).Copy 'données à copier
rgRecap.Offset(0, 1).PasteSpecial xlPasteValues 'valeurs seulement
End If
Set rg = rg.Offset(1, 0) 'prochaine ligne
Loop
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub