Ouvrir un classeur et récupérer les noms des onglets sur les colonne

Le 12/11/2021 à 19:11

je suis débutant sur VBA .

Je veux que ouvrir un classeur et récupérer les noms des onglets sur les colonne .

Par exemple

Colonne a onglet 1 colonne b onglet 2 ......

et ouvre un 2 classeur et faire la même chose sur la même classeur après la dernière colonne non vide et un 3 classeur ..... Et ainsi de suite

et merci

Le 13/11/2021 à 07:57

Bonjour,

Pouvez-vous préciser le répertoire dans lequel se trouvent ces X classeurs ?

Le classeur récepteur sera le classeur exécutant le code. Il devra, de préférence, se trouver en dehors du répertoire contenant tous les autres fichiers (de type xlsx ?).

Cdlt,

Le 13/11/2021 à 13:14

Oui les classeur son sur la même répertoire et le classeur récepteur en dehors . Merci

Le 19/11/2021 à 12:09

Bonjour Bara2,

Voici un code à essayer où il faudra adapter le répertoire :

sub test()
dim t()
spath = "C:\...\dossier" '<<<< ADAPTER
if dir(spath, vbdirectory) = "" then msgbox "dossier inexistant", 16: exit sub
sfile = dir(spath & "\*.xlsx")
do while sfile <> ""
    with workbooks.open(spath & "\" & sfile)
        for each ws in .worksheets
            n = n + 1: redim preserve t(1 to n)
            t(n) = ws.name
        next ws
        .close true
    end with
    sfile = dir
loop
if n = 0 then msgbox "Aucun fichier trouvé", 16: exit sub
with thisworkbook.sheets(1)
    nc = .cells(1, .columns.count).end(xltoleft).column + 1
    .cells(1, nc).resize(, n) = t
end with
end sub

Il faut bien que les fichiers sondés soient fermés au moment de l'exécution.

Les noms d'onglet sont inscrit en ligne 1 de la feuille 1 du classeur exécutant.

Cdlt,

Le 01/01/2022 à 16:41

bonjour

merci 3GB pour votre solution ca marche bien j'ai seulement modifier le chemin et la destination merci infiniment

j'ai une autre chose a faire avec ce classeur j'aimerais faire une recherche v d'un paramètres qui en ligne et somme de ce dernier ms avec condition de nom de la feuille deja prise sur les colonne sur le classeur

genre de

if cells(7,nc)= le nom de la feuille(x) sur le classeur (x) donc

rechrche range ("A9") sur la feuille (x) et faire une somme.si de paramètre qui ce troive en A9 et boucler cette fonction en ligne et colonne

merci d'avance

Le 03/01/2022 à 01:55

Bonsoir 3GB et bara2,

Le post de 3GB pour ouvrir le dossier par une macro m'intéresse, et çà marche pas pour moi, fichier fermé, avec:

2 
Sub dossier()
'ouvre un fichier dans un dossier. Le classeur récepteur sera le classeur exécutant le code
Dim t()
spath = "\Documents\FRANCK\EXCEL\" '<<<< ADAPTER"/documents/"
If Dir(spath, vbDirectory) = "" Then MsgBox "dossier inexistant", 16: Exit Sub
sfile = Dir(spath & "\*.xlsx")
Do While sfile <> ""
    With Workbooks.Open(spath & "\" & sfile)
        For Each ws In .Worksheets
            n = n + 1: ReDim Preserve t(1 To n)
            t(n) = ws.Name
        Next ws
        .Close True
    End With
    sfile = Dir
Loop
If n = 0 Then MsgBox "Aucun fichier trouvé", 16: Exit Sub
With ThisWorkbook.Sheets(1)
    nc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(1, nc).Resize(, n) = t
End With
End Sub

* c'est pour tous les fichiers, mais si on précise le nom du fichier, çà donne quoi ?

Merci pour votre aide.

Le 03/01/2022 à 17:10

Bonjour et bonne année à tous les 2,

@Fronck : Qu'est-ce qui ne fonctionne pas exactement ? Tu as un message ou rien du tout ?

En tout cas, pour cibler un fichier en fonction d'un mot, on fait comme ça :

sfile = Dir(spath & "\*MotClé*.xlsx")

Il est aussi possible et préférable de passer le mot clé en paramètre de la procédure pour la variabiliser.

Cdlt,

Edit :

Sub lancer()
spath$ = environ("userprofile") & "\Documents\FRANCK\EXCEL"
Ouvrir spath
end sub

Sub Ouvrir(spath$, optional MotClé$)
'ouvre un fichier dans un dossier. Le classeur récepteur sera le classeur exécutant le code
Dim t()
If Dir(spath, vbDirectory) = "" Then MsgBox "dossier inexistant", 16: Exit Sub
sfile = Dir(spath & "\*" & MotClé & "*.xlsx")
Do While sfile <> ""
    With Workbooks.Open(spath & "\" & sfile)
        For Each ws In .Worksheets
            n = n + 1: ReDim Preserve t(1 To n)
            t(n) = ws.Name
        Next ws
        .Close True
    End With
    sfile = Dir
Loop
If n = 0 Then MsgBox "Aucun fichier trouvé", 16: Exit Sub
With ThisWorkbook.Sheets(1)
    nc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(1, nc).Resize(, n) = t
End With
End Sub

NB : le chemin ne doit pas terminer par un anti-slash !

Le 03/01/2022 à 17:22

Le message est toujours:

1

le mot clé je sais pas ce que c'est. Si c'est le nom du fichier, c'est la même réponse "dossier inexistant". 

Sub dossier()
'ouvre un fichier dans un dossier. Le classeur récepteur sera le classeur exécutant le code
Dim t()
spath = "\Documents\FRANCK\EXCEL\" '<<<< ADAPTER"/documents/"
If Dir(spath, vbDirectory) = "" Then MsgBox "dossier inexistant", 16: Exit Sub
sfile = Dir(spath & "\*moyennes diferents pdts tablo*.xlsx")
Do While sfile <> ""
    With Workbooks.Open(spath & "\" & sfile)
        For Each ws In .Worksheets
            n = n + 1: ReDim Preserve t(1 To n)
            t(n) = ws.Name
        Next ws
        .Close True
    End With
    sfile = Dir
Loop
If n = 0 Then MsgBox "Aucun fichier trouvé", 16: Exit Sub
With ThisWorkbook.Sheets(1)
    nc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(1, nc).Resize(, n) = t
End With
End Sub
2

Merci quand même

Le 03/01/2022 à 22:02

C'est parce que le répertoire ne doit pas terminer par un anti-slash. Si tu le retires, ça devrait passer.

Bonne soirée,

Le 04/01/2022 à 01:37

c'est pareil désolé 3GB

1 
Sub dossier()
'ouvre un fichier dans un dossier. Le classeur récepteur sera le classeur exécutant le code
Dim t()
spath = "\Documents\FRANCK\EXCEL" 
If Dir(spath, vbDirectory) = "" Then MsgBox "dossier inexistant", 16: Exit Sub
sfile = Dir(spath & "\*moyennes diferents pdts tablo*.xlsx")
Do While sfile <> ""
    With Workbooks.Open(spath & "\" & sfile)
        For Each ws In .Worksheets
            n = n + 1: ReDim Preserve t(1 To n)
            t(n) = ws.Name
        Next ws
        .Close True
    End With
    sfile = Dir
Loop
If n = 0 Then MsgBox "Aucun fichier trouvé", 16: Exit Sub
With ThisWorkbook.Sheets(1)
    nc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(1, nc).Resize(, n) = t
End With
End Sub
2
Le 04/01/2022 à 22:42

Et si tu essayes le code de mon commentaire https://forum.excel-pratique.com/excel/ouvrir-un-classeur-et-recuperer-les-noms-des-onglets-sur-les-... édité à l'instant pour tenir compte de ton répertoire ?

Le 04/01/2022 à 23:42

Merci 3GB,

çà n'a pas beugué et tourné, mais je n'ai pas vu de recopie de noms d'onglets.

çà n'a pas ouvert le fichier fermé.

Et çà je comprends pas:

        For Each ws In .Worksheets
            n = n + 1: ReDim Preserve t(1 To n)
            t(n) = ws.Name
        Next ws

A plouch

Le 05/01/2022 à 22:55

Salut Fronck,

Sans bug ni message, il est peu probable qu'il ne se soit rien passé.

Voici le code commenté :

Sub lancer()
spath$ = environ("userprofile") & "\Documents\FRANCK\EXCEL" 'répertoire à sonder (argument de la procédure ouvrir)
Ouvrir spath 'ouvrir tous les fichiers xlsx du rep. spath, sans préciser de mot-clé
end sub

Sub Ouvrir(spath$, optional MotClé$)
'ouvre un fichier dans un dossier. Le classeur récepteur sera le classeur exécutant le code
Dim t() 'tableau des noms de feuille
If Dir(spath, vbDirectory) = "" Then MsgBox "dossier inexistant", 16: Exit Sub 'si spath n'existe pas, sortie et message
sfile = Dir(spath & "\*" & MotClé & "*.xlsx") 'initialisation sfile avec 1è entrée des fichiers xlsx de spath contenant le mot-clé rentré en argument (si omis, on parcourt tous les xlsx)
Do While sfile <> "" 'tant qu'il y a correspondance
    With Workbooks.Open(spath & "\" & sfile) 'avec le classeur xlsx en cours, ouvert à l'instant
        For Each ws In .Worksheets 'pour chacune de ces feuilles
            n = n + 1: ReDim Preserve t(1 To n) 'on incrémente notre compteur n et redimensionne le tableau t
            t(n) = ws.Name 'l'item n recoit le nom de la feuille en cours
        Next ws 'feuille suivante
        .Close True 'fermeture et sauvegarde du classeur en cours
    End With
    sfile = Dir 'contenu suivant
Loop
If n = 0 Then MsgBox "Aucun fichier trouvé", 16: Exit Sub 'si aucune corresp, sortie et message
With ThisWorkbook.Sheets(1) 'sinon, avec la feuille 1 du classeur exécutant
    nc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 '1è colonne vide en partant de la droite
    .Cells(1, nc).Resize(, n) = t 'restitution des noms (en ligne) à partir de la cellule en colonne nc et en ligne 1
End With
End Sub

Si jamais tu as un objectif précis, je pense qu'il vaut mieux que tu crées un sujet, ce sera probablement plus simple.

Bonne soirée,

Le 08/01/2022 à 04:24

Bonjour gmb,

Merci pour les explications. Il n'y a pas eut de recopie de noms d'onglets, mais pas de message d'erreur.

C'était juste pour info, je n'ai jamais laissé un robot ouvrir mes fichiers.

A+

Le 08/01/2022 à 18:22

Bonjour,

S'il n'y a pas eu de message, il y a forcément eu recopie des noms d'onglet sur la feuille 1 du classeur exécutant le code, à la dernière colonne de la ligne 1...

Pour voir ces noms, tu peux essayer ce code à coller dans le même classeur :

sub test()
with thisworkbook.sheets(1)
    .visible = true
    dc = .cells(1, .columns.count).end(xltoleft).column
    application.goto .cells(1, dc)
end with
end sub

Cdlt,

Le 08/01/2022 à 23:56

Salut 3GB,

Aprés réparation de l'ordi, je n'ai plus le disque dur jusqu'à mardi et en essayant sur un répertoire du disque SSD, malheureusement j'ai à nouveau le message d'erreur "dossier inexistant".

1

Voilà le code que j'ai mis dans le fichier test2.xlm

Sub lancer()
spath$ = Environ("userprofile") & "\Documents\macros" 'répertoire à sonder (argument de la procédure ouvrir)
Ouvrir spath 'ouvrir tous les fichiers xlsx du rep. spath, sans préciser de mot-clé
End Sub

Sub Ouvrir(spath$, Optional MotClé$)
'ouvre un fichier dans un dossier. Le classeur récepteur sera le classeur exécutant le code
Dim t() 'tableau des noms de feuille
If Dir(spath, vbDirectory) = "" Then MsgBox "dossier inexistant", 16: Exit Sub 'si spath n'existe pas, sortie et message
sfile = Dir(spath & "\*" & MotClé & "*test.xlsx") 'initialisation sfile avec 1'entrée des fichiers xlsx de spath contenant _
'le mot-clé rentré en argument (si omis, on parcourt tous les xlsx)
Do While sfile <> "" 'tant qu'il y a correspondance
    With Workbooks.Open(spath & "\" & sfile) 'avec le classeur xlsx en cours, ouvert à l'instant
        For Each ws In .Worksheets 'pour chacune de ces feuilles
            n = n + 1: ReDim Preserve t(1 To n) 'on incrémente notre compteur n et redimensionne le tableau t
            t(n) = ws.Name 'l'item n recoit le nom de la feuille en cours
        Next ws 'feuille suivante
        .Close True 'fermeture et sauvegarde du classeur en cours
    End With
    sfile = Dir 'contenu suivant
Loop
If n = 0 Then MsgBox "Aucun fichier trouvé", 16: Exit Sub 'si aucune corresp, sortie et message
With ThisWorkbook.Sheets(1) 'sinon, avec la feuille 1 du classeur exécutant
    nc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 '1è colonne vide en partant de la droite
    .Cells(1, nc).Resize(, n) = t 'restitution des noms (en ligne) à partir de la cellule en colonne nc et en ligne 1
End With
End Sub

Pour le mot clé je comprends toujours pas le "rentré en argument".

A+

Merci

Rechercher des sujets similaires à "ouvrir classeur recuperer noms onglets colonne"