Fonction VBA - multi classeurs

  • Initiateur de la discussion Initiateur de la discussion Mouss11
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M

Mouss11

Guest
Bonjour,

Je suis débutant en VBA

Je cherche un bout de code me permettant de faire les actions suivantes. J'ai dans un même répertoire plusieurs classeurs et j'aimerais :

- Que Excel calcule le nombre de feuilles de chaque classeur contenu dans ce répertoire et insère la valeur dans la prochaine cellule disponible de la colonne A a partir de la cellule A12 (des infos sont saisies de A1 a A12

-Que Excel report le nom du classeur en face du nombre de feuilles dans la colonne B a partir de la cellule B12 (exemple nombre de feuilles en A18; nom du classeur en B18)

Merci

Voici le code que j'ai commencé a écrire mais celui ci beug

Code:
Sub CLASSEUR()

Dim wbk As Excel.Workbook
fold_up = ThisWorkbook.Path

For Each wbk In fold_up
    Sheets("feuil1").Select
    Range("A12").Select
    Range(Selection, Selection.End(xlToDown)).Select
    Selection = Workbook.Sheets.Count
Next wbk

End Sub
 
Dernière modification par un modérateur:
Bonjour Mouss11, le forum

Un fichier qui extrait les informations. Pas tout à fait la demande mais on a le dossier actif, on peut avoir les dates de modifications (bouton en haut à mettre à jour après affichage des fichiers), le lien complet et un lien hypertexte pour ouvrir un fichier.
Les zones en grises ne doivent pas être supprimées (formules)

xl-ment
zebanx
 

Pièces jointes

Bonjour le fil, bonjour le forum,

Essaie comme ça :

VB:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichiers)
Dim CL As Workbook 'déclare la variable CL (CLasseur)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set O = ThisWorkbook.Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
CA = ThisWorkbook.Path 'définit le chemin d'accès CA
F = Dir(CA & "\*.xls*") 'définit le premier classeur excel ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des classeurs
    If Not F = ThisWorkbook.Name Then 'condition : si le classeur n'est pas celui-ci
        'définit la cellule de destination DEST (A12 si A12 est vide sinon, la première cellule vide de la colonne A de l'onglet O)
        If O.Range("A12") = "" Then Set DEST = O.Range("A12") Else Set DEST = O.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Set CL = Workbooks.Open(CA & "\" & F) 'définit le classeur CL en l'ouvrant
        DEST.Value = CL.Sheets.Count 'renvoie le nombre d'onglets dans DEST
        DEST.Offset(0, 1).Value = F 'renvoie le nom du classeur F dans DEST décalé d'une colonne à droite
        CL.Close False 'ferme le classeur CL sans enregistrer
        F = Dir 'définit le prochain classeur du dossier ayant CA comme chemin d'accès
    End If 'fin de la condition
Loop 'boucle
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub
 
Bonjour tout le monde !

Robert, merci pour ton code il marche nickel.

En revanche vu que la majorité de mes classeurs nt des liaisons Excel me demande pour chaque classeur si je veux mettre a jour les liaison. Y'a t-il un moyen d'automatiser la réponse , ne pas mettre a jour lors de l'ouverture ?

En tout cas merci pour ton aide 😉 !

Mouss
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
363
Réponses
3
Affichages
842
Retour