Microsoft 365 Tableau recap de tous les onglets en un clic

Sub recap()

For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> "Tables" Then
        With ws
            NbInt = 0
            NbExt = 0
            Jour = .Name
            Comptes = .Range("A" & .Rows.Count).End(xlUp).Row - 1
            Promesse = WorksheetFunction.Sum(.Range("C2:C" & Comptes + 1))
            For j = 2 To Comptes
                If Left(.Range("B" & j), 3) = "Int" Then NbInt = NbInt + 1
                If Left(.Range("B" & j), 3) = "Ext" Then NbExt = NbExt + 1
            Next j
        End With
        With Sheets("Tables")
            .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = Jour
            .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = Comptes
            .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = NbExt
            .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = NbInt
            .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = Promesse
        End With
    End If
Next ws
End Sub