XL 2016 Création d'un tableau récapitulatif

Function MoisCourant(réf As Range)
     Application.Volatile
     MoisCourant = UCase(Format(DateValue(réf.Worksheet.Name), "mmmm yyyy"))
End Function

Sub Actualiser()
     nbcols = 8
     Dim wsh As Worksheet, LO As ListObject, champ As Integer, tbRés()
     For Each wsh In ThisWorkbook.Worksheets
          If wsh.Name Like "####-##" Then
               Set LO = wsh.ListObjects(1)
               champ = LO.ListColumns("Payé").Index
               Tb = Evaluate(LO.Name).Value2
               For i = 1 To UBound(Tb)
                    If Tb(i, champ) = "NON" Then
                         Compteur = Compteur + 1
                         ReDim Preserve tbRés(1 To nbcols, 1 To Compteur)
                         For j = 1 To nbcols
                              tbRés(j, Compteur) = Tb(i, j)
                         Next j
                    End If
               Next i
          End If
     Next
     Set LO = sh_Récap.ListObjects(1)
     Set Rg = Evaluate(LO.Name)
     Rg.Rows.ClearContents
     LO.Resize LO.Range.Resize(2)
     If Compteur > 0 Then
          LO.Resize LO.Range.Resize(Compteur + 1)
          Evaluate(LO.Name).Value2 = WorksheetFunction.Transpose(tbRés)
     End If

End Sub

Sub Vider()
     Dim LO As ListObject
     Set LO = sh_Récap.ListObjects(1)
     Set Rg = Evaluate(LO.Name)
     Rg.Rows.ClearContents
     LO.Resize LO.Range.Resize(2)
End Sub

Private Sub Worksheet_Activate()
     Actualiser
End Sub