Faire référence à un numéro d'onglet dans la fonction refers to
Bonjour à tous,
J’essaie depuis quelques temps de réaliser un petit programme pour gagner du temps mais je bloque...je me tourne donc vers vous au cas ou vous auriez une solution!
Objectif du script: extraire certaines données de différents fichiers Excel (nombre d'onglets variables) pour les compiler dans un seul.
Fichiers données: Les fichiers sources ont la même forme, cependant le nombre d'onglet est variable. Ils sont rangés dans un même dossier.
En recherchant sur différents forums j'ai pu adapter le script suivant:
Sub Extraction2()
Dim Principal As ThisWorkbook
Dim Repertoire As String, fichier As String
Application.ScreenUpdating = False
Set Principal = ThisWorkbook
Repertoire = "C:\Users\gm65226\Desktop\test vba\anc"
ChDir Repertoire
xFichier = Dir("*.xls")
Sheets("test vba").[A2:C200].Clear 'initiale la zone du fichier à compléter
Do While xFichier <> ""
If xFichier <> Principal.Name Then ' prise en compte du fichier si le nom est different du fichier ouvert
For I = 1 To Sheets.Count ' donne le nombre total de feuilles du fichier traité
xLig = Sheets("test vba").Range("A65536").End(xlUp).Row + 1 ' indique le numéro de la dernière ligne complétée
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]Feuil(I)[/color]'!$A$1:$C$1"
With Sheets("Requete")
.[A1:C1] = "=plage"
.[A1:C1].Copy
Sheets("test vba").Range("A" & xLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.[A1:C1].Clear
End With
Next
End If
xFichier = Dir
Loop
ThisWorkbook.Names("plage").Delete
End SubLe programme "marche" globalement: les fichiers à onglet unique sont traités sans problème mais ceux à onglets multiples un peu moins.
Mon problème est le suivant: lorsque plusieurs onglets existent je dois sélectionner à la main l'onglet sur lequel le programme doit s'effectuer (message d'erreur " feuille de calcul introuvable, sélectionner la feuille à partir de laquelle mettre à jour les valeurs"), ce qui est assez embetant au vu du nombre de fichiers que je devrai traiter...
Le problème vient à mon avis de la ligne de code 14: j'ai inséré une boucle pour déterminer le nombre d'onglet de chaque fichier (ligne 12). Je comptais utiliser cette variable dans la ligne 14 pour caractériser le i ème onglet. Le problème vient du fait que la formule considère l'écriture ("Feuil(I)" dans le programme) comme le nom de l'onglet et non sont numéro... Auriez vous une solution à ce problème d'écriture?
Je vous remercie d'avance!
Bonjour,
sans tester j'ai l'impression que c'est de son nom que tu as besoin justement :
Feuil(I).nameeric
Bonjour,
Je pense qu'il faut remplacer
Feuil(I)par
Sheets(I).NameMerci de me dire si ça fonctionne
EDIT:
Salut Eric au passage
Bonjour,
Précision peut-être inutile, mais on sait jamais...
"]Feuil(I)[/color]'!$A$1:$C$1" 'écrit comme ça, c'est une chaîne de caractèresLe code de @eriic et @Ausecour s'intègre comme ça:
Sheets(I).Name & "!$A$1:$C$1"Salut Pedro
Boh une petite precisión ça ne fait pas de mal! Parfois certains membres te sortent des codes fous mais ne comprennent pas forcément la majorité des lignes, ça peut-être des trucs pris ça et là... En plus les String ça porte à confusión
oui, sheets(i) et non Feuil(i) que j'ai laissé passer
Heureusement qu'il y en a qui suivent
Je vous remercie pour votre rapidité!
C'est un peux mon cas j'ai bricolé à partir de codes trouvés ça et là... je comprends en gros ce que fait chaque ligne mais pas forcement toutes les implications qui vont avec... on fait avec les moyens du bord!
J'ai essayé avec le sheets(i).name mais cela ne change rien. Le message d'erreur dont je parlais dans mon premier message est toujours présent:
Explications: le Classeur 1 est mon fichier de données et p1, p2, ... les onglets qui le composent.
Si je comprends bien le message, sheets(i).name est considéré comme une chaine de caractère. Donc vu qu'aucun onglet ne possède ce nom le message apparait. C'est pour cela que je comptais essayer de passer par le numéro de l'onglet pour les traiter "un par un" sans avoir à s'occuper de leurs noms.
Ps:Pour l'histoire de la couleur chaine de caractères, je comptais juste surligner l'endroit que me semblait mal fonctionner dans mon code ce qui apparement n'a pas marché...désolé!
En tout cas merci beaucoup pour votre aide!
Normalement si tu fais Sheets(1).Name c'est censé renvoyer le nom de la première feuille, c'est embêtant ça...
Mois ça me renvoyait "Feuil1" Quand je testais en tout cas
Je vous remercie pour votre rapidité!
C'est un peux mon cas j'ai bricolé à partir de codes trouvés ça et là... je comprends en gros ce que fait chaque ligne mais pas forcement toutes les implications qui vont avec... on fait avec les moyens du bord!
J'ai essayé avec le sheets(i).name mais cela ne change rien. Le message d'erreur dont je parlais dans mon premier message est toujours présent:
Explications: le Classeur 1 est mon fichier de données et p1, p2, ... les onglets qui le composent.
Si je comprends bien le message, sheets(i).name est considéré comme une chaine de caractère. Donc vu qu'aucun onglet ne possède ce nom le message apparait. C'est pour cela que je comptais essayer de passer par le numéro de l'onglet pour les traiter "un par un" sans avoir à s'occuper de leurs noms.
En tout cas merci beaucoup pour votre aide!
Donne ton nouveau code complet
Voici le code modifié avec ce qui a été dit auparavant:
Sub Extraction()
Dim Principal As ThisWorkbook
Dim Repertoire As String, Fichier As String
Application.ScreenUpdating = False
Set Principal = ThisWorkbook
Repertoire = "C:\Users\gm65226\Desktop\test vba\anc"
ChDir Repertoire
xFichier = Dir("*.xls")
Sheets("test vba").[A2:C200].Clear 'initiale la zone du fichier à compléter
Do While xFichier <> ""
If xFichier <> Principal.Name Then ' prise en compte du fichier si le nom est different du fichier ouvert
For I = 1 To Sheets.Count ' donne le nombre total de feuilles du fichier traité
xLig = Sheets("test vba").Range("A65536").End(xlUp).Row + 1 ' indique le numéro de la dernière ligne complétée
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]sheets(I).name & '!$A$1:$C$1"
With Sheets("Requete")
.[A1:C1] = "=plage"
.[A1:C1].Copy
Sheets("test vba").Range("A" & xLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.[A1:C1].Clear
End With
Next
End If
xFichier = Dir
Loop
ThisWorkbook.Names("plage").Delete
End SubBonjour, Salut à tous !
Si j'ai bien lu : tu n'ouvres pas le fichier identifié, et Sheets non qualifiés réfèrent à ThisWorkbook, ce qui n'est pas l'objectif il me semble...
Pour parcourir les feuilles de l'autre classeur, il faut d'abord l'ouvrir, et qualifier tes Sheets en les faisant référer explicitement au classeur que tu viens d'ouvrir.
Cordialement.
Tu n'as pas dû lire ma petite "précision"...
Remplace la ligne :
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]sheets(I).name & '!$A$1:$C$1"Par:
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]" & Sheets(I).name & "'!$A$1:$C$1"Normal que ça ne marche pas, il ne faut pas mettre Sheets(I) comme du texte mais comme une variable, voici la correction de ton code qui devrait marcher :
Sub Extraction()
Dim Principal As ThisWorkbook
Dim Repertoire As String, Fichier As String
Application.ScreenUpdating = False
Set Principal = ThisWorkbook
Repertoire = "C:\Users\gm65226\Desktop\test vba\anc"
ChDir Repertoire
xFichier = Dir("*.xls")
Sheets("test vba").[A2:C200].Clear 'initiale la zone du fichier à compléter
Do While xFichier <> ""
If xFichier <> Principal.Name Then ' prise en compte du fichier si le nom est different du fichier ouvert
For I = 1 To Sheets.Count ' donne le nombre total de feuilles du fichier traité
xLig = Sheets("test vba").Range("A65536").End(xlUp).Row + 1 ' indique le numéro de la dernière ligne complétée
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]" & sheets(I).name & "'!$A$1:$C$1"
With Sheets("Requete")
.[A1:C1] = "=plage"
.[A1:C1].Copy
Sheets("test vba").Range("A" & xLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.[A1:C1].Clear
End With
Next
End If
xFichier = Dir
Loop
ThisWorkbook.Names("plage").Delete
End SubJe crois que je ne suis pas hyper doué: Pedro et Ausecour, la modification ne change rien, toujours le même message... Je vais essayer de réécrire le code en ouvrant les fichiers comme indiqué par MFerrand et je vous redis!
merci pour tout!
Bonjour,
cette ligne me paraît toujours bizarre en fait :
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Repertoire & "\[" & xFichier & "]" & sheets(I).name & "'!$A$1:$C$1"Je ne suis pas sûr que la syntaxe soit bonne, il faudrait que tu fasses un tour de tes différentes variables en mode débogage pour voir si tout est normal ou non...
Par exemple après ce code essaye de vérifier que le nom plage ait bien été ajouté à ton classeur, ou à la limite tu mets un espion sur plage pour voir, tu fais un clic droit sur plage et ajouter un espion, tu verras si ça reste vide et si non, ce qu'il y a dedans
Ça te fera peut-être avancer, tu sais qu'il y a un soucis quelque part, le soucis c'est de savoir où maintenant
Bonjour à tous,
J'ai fini par arriver au résultat que je souhaitais en ouvrant/enregistrant/fermant chaque fichier. C'est une script "un peu" plus lourd que celui de départ mais ça marche! J'ai contourné le problème sur la ligne qui avait un soucis: les fichiers traités n'ont plus qu'un onglet donc plus de problème de numéro/nom d'onglet!
Je vous mets le script final si cela vous intéresse ( et ça pourra peut être aussi aider d’autres personnes!)
Sub extraction()
Dim Principal As ThisWorkbook
Dim Repertoire As String, Fichier As String
Dim Wb As Workbook
Dim Ws As Sheets
Application.ScreenUpdating = False
Set Principal = ThisWorkbook
R_origine = "C:\Users\gm65226\Desktop\test vba\anc\" 'repertoire origine
R_programme = "C:\Users\gm65226\Desktop\test vba\nouv" 'repertoire pour le traitement du programme
ChDir R_origine
Fichier = Dir(R_origine & "*.xlsx")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''' Traitement des fichiers de données ''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Do While Fichier <> ""
If Fichier <> Principal.Name Then
Set Wb = Workbooks.Open(Chemin & Fichier)
nb_onglet = Sheets.Count 'donne le nombre d'onglets du fichier ouvert
'traite le fichier suivant le nombre d'onglets
If nb_onglet = 1 Then 'si un unique onglet enregistre avec le nom des forets et parcelle dans le répertoire dédié
sauvegarde = R_programme & "\" & Range("B5") & "_" & Range("F5") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=sauvegarde
Wb.Close True
Set Wb = Nothing
Else 'si plusieurs onglets: eclate le fichier et enregistre chaque onglet dans un fichier excel propre
'MsgBox ("pls onglets")
Set Wb = Workbooks.Open(Chemin & Fichier)
For I = 1 To nb_onglet
Set Wb = Workbooks.Open(Chemin & Fichier)
'MsgBox (I)
Sheets(I).Select
Sheets(I).Copy
'MsgBox (R_programme & "\" & Range("B5") & "_" & Range("F5") & ".xlsx")
ActiveWorkbook.SaveAs Filename:=R_programme & "\" & Range("B5") & "_" & Range("F5") & ".xlsx"
Wb.Close True
ActiveWorkbook.Close True
Set Wb = Nothing
Next
End If
End If
Fichier = Dir
Loop
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''' Extraction des informations de chaque classeur Excel'''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
xFichier = Dir(R_programme & "\" & "*.xlsx")
Sheets("test vba").[A2:C200].Clear 'initialise la zone du fichier à compléter
Do While xFichier <> ""
If xFichier <> Principal.Name Then ' prise en compte du fichier si le nom est different du fichier ouvert
xLig = Sheets("test vba").Range("A65536").End(xlUp).Row + 1 ' indique le numéro de la ligne a compléter dans le fichier contenant les resultats du programme
ThisWorkbook.Names.Add "plage", RefersTo:="='" & R_programme & "\[" & xFichier & "]Feuil1'!$A$1:$C$1"
With Sheets("Requete")
.[A1:C1] = "=plage"
.[A1:C1].Copy
Sheets("test vba").Range("A" & xLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.[A1:C1].Clear
End With
End If
xFichier = Dir
Loop
ThisWorkbook.Names("plage").Delete
Application.ScreenUpdating = True
End SubEn tout cas un grand merci à tous pour le temps que vous m'avez accordé!