Sub test()
CopieFeuilles 10, 18
End Sub
Sub CopieFeuilles(BorneInf As Integer, BorneSup As Integer)
Dim i As Long, A(), N As Integer
With ThisWorkbook
If BorneInf < 1 Then BorneInf = 1
If BorneSup > .Sheets.Count Then BorneSup = .Sheets.Count
If BorneInf > BorneSup Then Exit Sub
For i = BorneInf To BorneSup
If .Sheets(i).Range("A4").Value <> "" Then
N = N + 1
ReDim Preserve A(1 To N)
A(N) = i
End If
Next i
If N > 0 Then .Sheets(A).Copy
End With
End Sub