Compter nombre des feuils

salut les excelists

je cherche, si c'est possible, un code VBA pour compter le nombre de feuils de terminant par (TC) dans un classeur et mettre le résultat dans une cellule

merci d'avance

Bonjour TxAcid,

Décidément, encore moi !

Sub NbTC()

Dim ws as worksheet
Dim NF as byte

for each ws in worksheets
    if right(ws.name, 2) = "TC" then
        NF = NF + 1
    end if
next ws

msgbox "Il y a "& NF & " feuilles TC"

end sub

'variante fonction personnalisée à saisir directement sur excel

Function NbTC()

Dim ws as worksheet
Dim NF as byte

for each ws in worksheets
    if right(ws.name, 2) = "TC" then
        NF = NF + 1
    end if
next ws

NbTC = NF

end function

Cdlt,

Bonjour,

Un truc du genre pourrait faire l'affaire (non testé et écrit du téléphone, il peut y avoir des coquilles :

Sub compter()
Dim compteur as integer
Dim sh as worksheets
Compteur = 0

For each sh in activeworkbook
    If right(sh.name, 2) = "TC" then compteur = compteur +1
Next
Sheets(1).cells(1,1) = compteur
 end sub

Edit : arf, hello 3GB 😁

Salut JoyeuxNoel,

Oui et moi comme un zozo je renvoie une msgbox !

salut les amis, on dirait Batman et Robin, car vous-etes mes sauveurs, pour la nème fois.

y eu un pépin sur les deux codes, mais j'ai combiné entre eux pour trouver la solution qui me convient

Sub NbrTC()
Dim ws As Worksheet
Dim i%
Dim Somme(4)

For Each ws In Worksheets
    If Right(ws.Name, 2) = "tc" Then
        NF = NF + 1
    End If
Next ws

Sheets("Feuil1").Range("E6").Value = NF

End Sub

merci encore

Je vais un peu défendre ma cause mais il pourrait être pratique d'utiliser la fonction.

Ensuite, il suffit d'aller dans n'importe quelle cellule (en E6 en l'occurrence) et de saisir :

=NbTC()

pour obtenir le nombre de feuilles. Donc pas besoin de gérer l'exécution de la macro.

Bonjour,

Sub NbrTC()
Dim ws As Worksheet, NF As Double
    For Each ws In Worksheets
        If Right(ws.Name, 2) = "tc" Then NF = NF + 1
    Next ws
    Worksheets("Feuil1").Range("E6").Value = NF
End Sub

Bonjour à tous,

fonction plus générale pour passer 5 min :

Function nbFeuilles(ByVal motif As String) As Long
    Dim sh As Worksheet
    ' motif : forme du nom des feuilles avec joker *
    ' commence par F, motif ="F*"
    ' fini par TC, motif ="*TC"
    ' contient eui, motif ="*eui*"
    Application.Volatile
    motif = LCase(motif)
    For Each sh In Worksheets
        nbFeuilles = nbFeuilles - (LCase(sh.Name) Like motif)
    Next sh
End Function

Ex sur feuille : =nbFeuilles("*TC")
Pas grand monde a pensé à la faire volatile
eric

Bonsoir eriiic,

Merci pour cette intervention, je me demandais justement (enfin j'étais persuadé mais sans connaître le moyen) s'il y avait pas une solution comme celle que tu proposes. Il faut que je me renseigne sur l'opérateur Like

Et en plus, très bonne remarque sur la nécessité d'ajouter application.volatile.

Juste, j'ai l'impression qu'il y a une petite faute de frappe et que la ligne dans la boucle devrait être :

nbFeuilles = nbFeuilles + (LCase(sh.Name) Like motif)

En tout cas, bravo .

Bonne soirée,

Re,
Bonsoir 3GB,

Non, il faut bien laisser le - et non mettre +

VRAI en vba = -1, il faut donc les soustraire pour retourner un résultat positif.
eric

Bonjour eriiic,

Et bien, j'apprends quelque chose, j'étais convaincu que vrai valait 1.

Merci pour ton message.

Cdlt,

Bonjour,

il y a un piège, sur feuille il vaut 1
eric

Bonjour ...

@eric, réponse 0 chez moi malgré de ce tu appelles piège (bien vu quand même !).

Je pencherais plutôt pour

Function nbFeuilles(ByVal motif As String) As Long
  Dim sh As Worksheet
  Application.Volatile
  For Each sh In Worksheets
    nbFeuilles = nbFeuilles - (sh.Name Like "*" & motif)
  Next
End Function 

en proposant aussi, dans la fenêtre des codes de ThisWorkbook pour une réponse dans la cellule A1 de chaque feuille :

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal R As Range)
   If R.Address <> Sh.[A1].Address Then Exit Sub 
  Dim F As Worksheet, tx As String
   tx = "*tc": R = 0
  For Each F In Sheets: R = R - (F.Name Like tx): Next
  R(2, 1).Select 'pour une autre reprise
End Sub

Chez moi ça a l'air de bien fonctionner

Re

Oups, excuse-moi er …reur , j’ai fait une mauvaise manipulation (présence de blancs invisibles sur mon fichier de test des différentes macros) . Je confirme : c’est tout bon !