Recherche valeurs sur plusieurs feuilles

Option Explicit

Public Declare Function QueryPerformanceCounter Lib "Kernel32" (x As Currency) As Boolean
Public Declare Function QueryPerformanceFrequency Lib "Kernel32" (x As Currency) As Boolean

Sub Tst()
Dim iDep As Long
Dim ws As Worksheet
Dim iLastRow As Long
Dim Dep As Currency, Fin As Currency, Freq As Currency

    QueryPerformanceCounter Dep
    Application.StatusBar = ""
    Application.ScreenUpdating = False
    ShRecap.Cells.Clear
    iDep = 1
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> ShRecap.Name Then
            ws.Activate
            ws.Range("A8:N38").Copy ShRecap.Range("B" & iDep)
            ws.Range("A123:N153").Copy ShRecap.Range("B" & iDep + 31)
            iDep = iDep + 62
        End If
    Next ws
    
    Suppression_LignesVides ShRecap, 1, 14
    With ShRecap
        .Activate
        .Range("P1").Select
    End With
    Application.ScreenUpdating = True

    QueryPerformanceCounter Fin: QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format(((Fin - Dep) / Freq), "0.00 s")
End Sub

Private Sub Suppression_LignesVides(ws As Worksheet, ColDep As Long, ColFin As Long)
Dim i As Long
Dim iMax As Long
Dim sStr As String
    ws.Activate
    iMax = ws.UsedRange.Rows.Count
    For i = iMax To 1 Step -1
        If Application.WorksheetFunction.CountBlank(ws.Range(Cells(i, ColDep), ws.Cells(i, ColFin))) = 14 Then
            ws.Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

	    ShRecap.Range("B2:O65536").Clear
	    iDep = 2
	    .....
                 Ws.Range("A8:N38").Copy ShRecap.Range("B" & iDep)
                 Ws.Range("A123:N153").Copy ShRecap.Range("B" & iDep + 31)
	    .....
                 SuppressionLignesVides ShRecap, 2, 15
            .....

	.....
	For i = iMax To 2 Step -1
	.....