Extraire le nb de lignes de differents fichiers

Sub Lire_Fichier_Ferme()
    Dim P As Long, Fichier As String, Chemin As String, PL As Long
    Dim Cnn As Object, RsL As Object
    Dim TLigne()
    
    With Worksheets("SHFICHIERS")
        Plage = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row)     'mise en memoire Plage de cellules
    End With
    Nb1 = UBound(Plage, 1): PL = -1: ReDim TLigne(Nb1 + 1)
    For P = 1 To Nb1
        'boucle sur colonne A et B pour repertoire et fichier
        Chemin = Plage(P, 1)
        Fichier = Plage(P, 2)
        Set Cnn = CreateObject("ADODB.Connection")
        Set RsL = CreateObject("ADODB.Recordset")
        With Cnn
            .ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & Chemin & "\" & Fichier & ";ReadOnly=true;"
            .Open
        End With
        Set RsL = Cnn.Execute("SELECT count(*) as nb FROM [Base$]")
        PL = PL + 1
        TLigne(PL) = RsL("nb")          'mettre +1 si pas d'entete
        Cnn.Close
        Set RsL = Nothing
        Set Cnn = Nothing
    Next P
    Worksheets("SHFICHIERS").Range("C1").Resize(Nb1 + 1) = Application.Transpose(TLigne)
End Sub