Mise à jour d'un fichier multiples dossiers

Bonjour,

Voyant que vous n'obtenez pas de réponse, je vais essayer de vous donner une piste mais je ne suis pas un expert en matière de manipulation de dossiers.

Ici, je pars du principe que tous vos sous-dossiers sont dans ce même dossier "C:\...\destination", et que ceux-ci ne contiennent (lorsqu'ils en contiennent un) qu'un fichier nommé "azerty.xlsm", duquel vous cherchez à extraire la feuille en 3e position.

La macro suivante est prévue pour s'exécuter à partir du classeur "modifier" et ne sert qu'à importer (copier et pas déplacer) les onglets des fichiers "anciens" dans le fichier "modifier".

Pour le reste, il faudra éventuellement adapter. Voici le code :

Sub ImporterOngletsAnciens()

Dim NomFichier$ 'nom du fichier sur lequel se trouve l'onglet à récupérer
Dim Dossier$ 'Répertoire de base
Dim SousDossier$ 'Variable string pour sous-répertoires
Dim Chemin$ 'Variable chemin complet des fichiers des sous-rep
Dim Cible$ 'Variable nom fichier dans sous-rep
Dim Reprise$ 'Variable tampon pour reprendre après sous-rep déjà traité
Dim WbCible As Workbook 'Variable classeur à récupérer

NomFichier = "azerty.xlsm"
Dossier = "C:\Users\pascal\Desktop\destination\" 'ou ThisWorkbook.Path & "\" si fichier "modifier" se trouve dans destination
SousDossier = Dir(Dossier, vbDirectory)  'Renvoie nom des fichiers et sous rep de Dossier (à cette ligne, renvoie le 1er. Renverra les suivants à chaque SousDossier = Dir >> voir fin de boucle)

While SousDossier <> ""  'tant que SousDossier n'est pas vide <> tant qu'il existe des fichiers dans le dossier destination
    If (GetAttr(Dossier & SousDossier) And vbDirectory) <> 0 Then 'si SousDossier en cours est un répertoire
        Chemin = Dossier & SousDossier & "\" & NomFichier 'affectation nom du chemin complet
        Cible = Dir(Dossier & SousDossier & "\")  'Renvoie le nom du fichier en cours du sous rep
        Do While Cible <> "" 'tant qu'il existe des fichiers dans ce sous rep
                If Cible = NomFichier Then  'si ce fichier a pour valeur le nom du fichier cherché (azerty.xlsm)
                    Workbooks.Open Chemin 'Ouverture de ce fichier (classeur excel en l'ocurrence) - RQ : celui-ci devient le classeur actif
                    Set WbCible = ActiveWorkbook 'Affectation Objet Workbook (pour éviter confusion avec notre classeur d'accueil
                    WbCible.Sheets(3).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copie de la feuille n°3 (du classeur actif "ancien") en dernière position du classeur d'accueil "modifier"
                    WbCible.Close savechanges:=True 'fermeture avec sauvegarde du classeur ancien
                    Set WbCible = Nothing 'libération de la variable workbook
                End If
                Cible = Dir  'ON PASSE AU FICHIER SUIVANT DU SOUS-REP EN COURS
        Loop

    Reprise = Dir(Dossier, vbDirectory) 'RETOUR AU DOSSIER DE BASE QUAND L'ANALYSE DU SOUS DOSSIER EST FINIE
    While Reprise <> SousDossier 'TANT QUE FICHIER EN COURS <> DU SOUS-REP AUQUEL ON SEST ARRETE
        Reprise = Dir 'ON REPARCOURT TOUS LES FICHIERS DU DOSSIER (POUR EVITER DE COPIER INDEFINIMENT LE MEME FICHIER)
    Wend

    End If
SousDossier = Dir 'ON PASSE AU FICHIER SUIVANT DU REP DE BASE
Wend

End Sub

J'ai testé et ça fonctionne sur mon mac. J'espère que ça marchera sur windows.

Sinon, peut-être que quelqu'un de plus compétent saura améliorer cet essai.

Cordialement,

Bonjour,

Excusez moi du retard pour la réponse.

Je viens de tester votre code et cela va me servir pour arriver a faire exactement ce que je recherche.

Je vous tiendrais au courant .

Merci beaucoup en tout cas d'avoir pris de votre temps pour vous penchez sur mon problème

:)

Bonjour,

Je vous en prie, aucun problème.

Je serais heureux si ça fonctionnait sans souci de votre côté.

Cordialement,

Bonjour,

Comme promis je vous fait un retour de situation.

Avec quelques modifications tout fonctionne et je suis même arrivé à améliorer mon programme.

Merci à vous de m'avoir sorti cette épine du pied.

Bonne journée

Bonjour,

Merci, c'est gentil à vous.

Et bien je suis ravi qu'il fonctionne, c'est le genre de programme qui peut s'avérer bien utile...

Bonne journée à vous aussi,