Recherche de donnée sur classeur

Sub Recap()
    Dim w As Worksheet, i As Long, j As Integer
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Recap").Delete
    Sheets.Add.Name = "Recap"
    '
    For Each w In Worksheets
        If w.Name <> "Recap" Then
            i = i + 1
            ' recup nom feuille
            Cells(i, 1).Value = w.Name
            ' recup D7, D8, D9, D10 des feuilles
            For j = 2 To 5
                Cells(i, j).Value = w.Cells(j + 5, 4).Value
            Next j
        End If
    Next w
    Application.DisplayAlerts = True
End Sub