Copier des onglets venant de différents fichiers

Bonjour à tous,

voici mon soucis:

j'ai plusieurs fichiers Excel dans un même répertoire, contenant 12 onglets, nommées Janvier, Février, Mars, ect.

je dois créer une macro dans un fichier récapitulatif, qui permet d'y copier tous les onglets nommés Septembre par exemple.

J'ai bien réussi à faire un code pour ouvrir tous les fichiers du répertoire comme ceci :

Sub ouvrirfichiers()
Dim fichier As String
Dim Chemin As String
Dim Wb As Workbook

Chemin = "C:\blabla\"
fichier = Dir(Chemin & "*.xls")

Do While fichier <> ""
Set Wb = Workbooks.Open(Chemin & fichier)

Set Wb = Nothing
fichier = Dir
Loop

mais je ne vois pas comment m'y prendre pour la suite du code afin de copier les onglets "Septembre" de tous ces fichiers ouverts dans mon fichier récapitulatif.

merci de votre aide.

(je précise que je suis débutante en vba!)

Bonjour,

Voici un essai avec création du fichier récapitulatif, faute d'informations à ce niveau là. L'utilisateur est invité à saisir le nom de l'onglet. Aussi, la macro appelle une fonction pour contrôler l'existence de l'onglet dans le classeur.

Sub ouvrirfichiers()

Dim Wb As Workbook, WbRecap as workbook
Dim Onglet$, fichier$, Dossier$, Controle$
Dim i%

Onglet = inputbox("Saisissez le nom d'onglet à copier", "Nom de l'onglet") 'indiquer le nom de l'onglet
If Onglet = "" then Exit sub 'si annulation, sortie procédure
'éventuellement rajouter lignes ci-dessous
'if not ControlePresenceOnglet(thisworkbook, Onglet) then 'si l'onglet n'existe pas dans le classeur courant
    'msgbox "cet onglet n'existe pas dans ce classeur"
    'Exit sub 'sortie procédure
'End if

Dossier = "C:\blabla\"
fichier = Dir(Chemin & "*.xls")

While fichier <> "" 'tant qu'il y a des fichiers
    Set Wb = Workbooks.Open(Dossier & fichier) 'wb devient classeur en cours
    if ControlePresenceOnglet(wb, Onglet) then 'si onglet existe dans wb
        i = i + 1 'incrémentation
        if i = 1 then 'si premier fichier ouvert contenant Onglet
            wb.sheets(Onglet).copy 'on copie l'onglet de wb dans un nouveau classeur
            Set wbrecap = Activeworkbook 'le classeur actif (créé) devient wbrecap
            wbrecap.name = "Recap " & Onglet & format(Now, "YYMMDD-HHMM") & ".xls" 'on le renomme
        else 'quand i > 1, avec les autres fichiers
            wb.sheets(Onglet).copy after:=wbrecap.sheets(i-1) 'on copie l'onglet de wb après le dernier onglet de recap
        end if
        wbrecap.sheets(Onglet).name = Onglet & "i" 'dans tous les cas, on renomme l'onglet en fonction de son index
    end if
    wb.close 'on ferme le classeur wb
    Set Wb = Nothing
    fichier = Dir 'fichier suivant
Wend

wbrecap.close savechanges:=true 'on ferme et sauvegarde wbrecap
Set wbrecap = nothing

End sub

Function ControlePresenceOnglet(Classeur as workbook, NomFeuille as string) as Boolean

Dim ws as worksheet

for each ws in Classeur.worksheets 'pour chaque feuille du classeur
    if ws.name = NomFeuille then 'si le nom de la feuille correspond au nom à tester
        ControlePresenceOnglet = True 'renvoie true (feuille existe)
        Exit function 'sortie fonction
    end if
next ws

End Function

Cdlt,

Bonjour

Merci beaucoup pour votre réponse, je vais tester aujourd'hui.

Bonjour,

Vous avez bien copié tout le code (la fonction y compris) ?

Cdlt,

Je viens de m'apercevoir que la fonction ne s'était pas correctement copié, merci, ça marche.

Par contre j'ai maintenant un nouveau message d'erreur quand je lance la macro.

A priori il ouvre bien un nouveau fichier et copie l'onglet "Septembre" du 1ere fichier Excel de mon dossier mais il bloque et affiche : "Nombre d'arguments incorrect ou affectation de propriété incorrecte"

merci beaucoup pour votre aide!

A quelle ligne est cette erreur ?

Quand je fais le pas à pas détaillé c'est à ce niveau que ça coince :

Set wbrecap = ActiveWorkbook 'le classeur actif (créé) devient wbrecap
wbrecap.Name = "Recap " & Onglet & Format(Now, "YYMMDD-HHMM") & ".xls" 'on le renomme
Else 'quand i > 1, avec les autres fichiers

Pour info, le nouveau fichier ne se renomme pas, il s'appelle "classeur 1"

Oui, j'ai essayé de le renommer trop tôt alors qu'il est ouvert...

Peux-tu essayer ainsi :

Sub ouvrirfichiers()

Dim Wb As Workbook, WbRecap as workbook
Dim Onglet$, fichier$, Dossier$, Controle$
Dim i%

Onglet = inputbox("Saisissez le nom d'onglet à copier", "Nom de l'onglet") 'indiquer le nom de l'onglet
If Onglet = "" then Exit sub 'si annulation, sortie procédure
'éventuellement rajouter lignes ci-dessous
'if not ControlePresenceOnglet(thisworkbook, Onglet) then 'si l'onglet n'existe pas dans le classeur courant
    'msgbox "cet onglet n'existe pas dans ce classeur"
    'Exit sub 'sortie procédure
'End if

Dossier = "C:\blabla\"
fichier = Dir(Chemin & "*.xls")

While fichier <> "" 'tant qu'il y a des fichiers
    Set Wb = Workbooks.Open(Dossier & fichier) 'wb devient classeur en cours
    if ControlePresenceOnglet(wb, Onglet) then 'si onglet existe dans wb
        i = i + 1 'incrémentation
        if i = 1 then 'si premier fichier ouvert contenant Onglet
            wb.sheets(Onglet).copy 'on copie l'onglet de wb dans un nouveau classeur
            Set wbrecap = Activeworkbook 'le classeur actif (créé) devient wbrecap
        else 'quand i > 1, avec les autres fichiers
            wb.sheets(Onglet).copy after:=wbrecap.sheets(i-1) 'on copie l'onglet de wb après le dernier onglet de recap
        end if
        wbrecap.sheets(Onglet).name = Onglet & i 'dans tous les cas, on renomme l'onglet en fonction de son index
    end if
    wb.close 'on ferme le classeur wb
    Set Wb = Nothing
    fichier = Dir 'fichier suivant
Wend

wbrecap.close savechanges:=true, filename;="Recap " & Onglet & format(Now, "YYMMDD-HHMM") & ".xls" 'on ferme et sauvegarde recap au nom désiré

Set wbrecap = nothing

End sub

Cdlt,

Bonjour,

ça fonctionne!! merci beaucoup!

J'ose de demander une dernière petite question, si je souhaite que le nom de l'onglet une fois copié soit égale à la cellule R2 de cet onglet est-ce possible? (il correspond au prénom de la personne concerné par la feuille)

un grand merci pour ton aide.

Super !

Oui, normalement comme ça, ça devrait le faire :

wbrecap.sheets(Onglet).name = Onglet & i '<<<<<ligne à remplacer par :

wbrecap.sheets(Onglet).name = wbrecap.sheets(Onglet).range("R2").value & i

Je pense que les prénoms ne seront pas les mêmes mais j'ai laissé, par précaution, le petit & i pour éviter les doublons de nom (et donc un bug). A toi de voir...

Cdlt,

C'est parfait! merci beaucoup!