Copier coller un onglet d'un fichier à la meme racine

Le 07/11/2020 à 12:20

Bonjour à tous,

Je souhaite copier l'onglet d'un fichier qui se trouve à la même racine que le fichier maitre et cela peut importe le nom du fichier,

Sachant que dans le fichier source il n'y aura que deux fichier : le fichier maitre et l'export, l'objectif est de faciliter l'export pour les utilisateurs, pas de nom de à changer sur l'export.

J'ai déjà une solution qui fonctionne mais qui est capricieuse, après le premier import de l'export dans le fichier maitre, il est impossible de ré-exécuter la macro.

Certes les données sont déjà injectées dans le fichier maitre mais si l'utilisateur ré-importe le fichier après avoir refermer le fichier maitre, cela me dit que le fichier à importer n'est pas trouvable.

Comme si l’ouverture et la fermeture du fichier lors de la première manip faisait disparaitre le fichier d'export pour la macro.

Sub Injectionexportdesformations()

'permet de copier les évènements du fichier source dans ce fichier dans l'onglet export

Dim CC As Workbook 'déclare la variable CC (Classeur Cible)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
Dim F As String 'déclare la variable F (Fichiers)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DerniereLigne As Long
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Sheets("Export formation").Range("A:N").ClearContents ' on vide les anciens exports

Set CC = ThisWorkbook 'définit le classeur cible CC
Set OC = CC.Sheets("Export formation") 'définit l'onglet cible OC (à adapter)
F = Dir(CC.Path & "\*.xlsx?") 'définit le fichier F (premier fichier Excel du dossier contenant ce classeur)

Do While F <> "" 'boucle tant qu'il existe des fichiers
If Not F = CC.Name Then 'condition : si F n'est pas ce classeur
Workbooks.Open (F) 'ouvre le fichier F
Set CS = ActiveWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Places Disponibles") 'définit l'onglet source OS
Set PL = OS.Range("A:N") 'définit la plage PL
'définit la cellule de destination DEST (A1 si A1 est vide,
'sinon la première cellule vide de la colonne 1 (=A) de l'onglet cible OC (à adapter)
Set DEST = IIf(OC.Range("A1").Value = "", OC.Range("A1"), OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
PL.Copy DEST 'copy la plage PL dans DEST

CS.Close 'ferme le classeur source
End If 'fin de la condition
F = Dir 'redéfinit le fichier F (prochain fichier Excel du dossier contenant ce classeur)
Loop 'boucle
'Permet d'étendre les formules de l'onglet export jusqu'a la fin des nouveaux évènements
End Sub

Edit : merci de mettre le code entre balises grâce au bouton </>

Pour tester le problème, je vous invite à :

Mettre les deux fichiers dans le même dossiers, exécuter la macro, sauvegarder le fichier maitre, fermer le fichier maitre puis l'ouvrir, puis injecter à nouveau,

De plus si le fichier export est deposé dans le dossier sans que le fichier maitre soit ouvert, il n'est pas possible de l'ouvrir par la suite

Le message : Erreur d'excution 1004, Désolo.. Nous ne trouvons pas export.xlsx. Peut etre l'avez vous deplacé, renommé ou supprimé ?

Est il possible de contourner ce problème ?

Merci d'avance pour votre aide,

Bon samedi,

10aide-export.xlsm (162.94 Ko)
12export.xlsx (144.90 Ko)
Le 07/11/2020 à 12:52

Bonjour Smecta, bonjour le forum,

Le code modifié :

Sub Injectionexportdesformations()
Dim CC As Workbook 'déclare la variable CC (Classeur Cible)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichiers)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CC = ThisWorkbook 'définit le classeur cible CC
Set OC = CC.Sheets("Export formation") 'définit l'onglet cible OC (à adapter)
CA = CC.Path & "\" 'définit le chemin d'accès CA
OC.Range("A1").CurrentRegion.Offset(1, 0).ClearContents ' on vide les anciens exports (sauf la première ligne)
F = Dir(CA & "*.xlsx?") 'définit le fichier F (premier fichier Excel du dossier contenant ce classeur)
Do While F <> "" 'boucle tant qu'il existe des fichiers F
    If Not F = CC.Name Then 'condition : si F n'est pas ce classeur
        Workbooks.Open (CA & F) 'ouvre le fichier F
        Set CS = ActiveWorkbook 'définit le classeur source CS
        Set OS = CS.Sheets("Places Disponibles")  'définit l'onglet source OS
        Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL
        Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
        'définit la cellule de destination DEST (A1 si A1 est vide,
        'sinon la première cellule vide de la colonne 1 (=A) de l'onglet cible OC (à adapter)
        Set DEST = IIf(OC.Range("A1").Value = "", OC.Range("A1"), OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        PL.Copy DEST 'copy la plage PL dans DEST
        CS.Close False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
    F = Dir 'redéfinit le fichier F (prochain fichier Excel du dossier contenant ce classeur)
Loop 'boucle

'Permet d'étendre les formules de l'onglet export jusqu'a la fin des nouveaux évènements
End Sub

Il devait d'ailleurs ressembler à ça quand tu l'as récupérer...

Rechercher des sujets similaires à "copier coller onglet fichier meme racine"