VBA - Déplacer et Renommer onglet depuis un autre fichier

Question

Je ne pourrais pas joindre de fichier donc je vais essayer d'être le plus clair possible. J'ai un dossier avec plusieurs fichiers, l'idée étant d'aller créer deux onglets, modifier le nom des deux onglets ET les déplacer vers la fin. Pour la partie sélection des fichiers / ouverture / copie des onglets / enregistrement pas de soucis (j'ai modifié quelques lignes issus d'un code trouvé sur un forum). La où ça se complique c'est sur la "mise en forme", c'est à dire le fait de renommer des onglets et de les déplacer. Vous trouverez ci-dessous le code entier pour avoir tout le cheminement et les déclaration de variable et je me permettrais de remettre la partie "problématique". A savoir que lors de l'exécution de la macro il n'y a aucun problème, il ne se passe juste rien. Pour le nom des onglets je peux le contourner en renommant directement dans le fichier source mais à l'avenir j'aimerai utiliser une variable donc autant le faire fonctionner directement correctement Pour le placement des onglets je sais que je peux le faire directement lors de la création mais je n'y arrive pas ... Comme si la macro ne comprenait pas sur quel fichier compter les onglets existants pour mettre les nouveaux à droite. Function Selectionner_Fichiers(sTitre As String) As Variant Dim sFiltre As String, bMultiSelect As Boolean sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*" bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect) End Function Sub AJOUT_DONNEES() Dim wbOrigine As Workbook 'fichier actuel Dim wsOrigine As Worksheet 'feuille actuelle 1 Dim wsOrigine2 As Worksheet 'feuille actuelle 2 Dim wbOuvert As Workbook 'fichier à ouvrir Dim wsOuvert As Worksheet 'feuille du fichier à ouvrir Dim vFichiers As Variant 'noms des fichiers Dim i As Integer, k As Integer Dim rgRecap As Range 'plage où on copie les données Set wbOrigine = ThisWorkbook 'Fichier récapitulatif Set wsOrigine = wbOrigine.Sheets("Onglet1") 'Onglet à copier Set wsOrigine2 = wbOrigine.Sheets("Onglet2") 'Onglet à copier 2 ' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers ' --- Vérifier qu'au moins un fichier à été sélectionné If Not IsArray(vFichiers) Then Debug.Print "Aucun fichier sélectionné." MsgBox "Erreur! Aucun/Mauvais fichier sélectionné." Exit Sub End If On Error Resume Next Application.ScreenUpdating = False ' --- Boucle à travers les fichiers For k = 1 To UBound(vFichiers) Application.StatusBar = "&gt;&gt; Lecture du fichier #" & k & "/" & UBound(vFichiers) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Instructions : Set wbOuvert = Workbooks.Open(vFichiers(k), UpdateLinks:=False) wsOrigine.Copy Before:=wbOuvert.Sheets(1) wsOrigine2.Copy Before:=wbOuvert.Sheets(1) '-------- ICI CELA NE FONCTIONNE PAS wbOuvert.wsOuvert.Move After:=Sheets(Sheets.Count) wbOuvert.wsOuvert2.Move After:=Sheets(Sheets.Count) wbOuvert.wsOuvert.Name = "Performance - Potentiel" wbOuvert.wsOuvert2.Name = "Risques et impact départ" ' ----- ICI OK -------------------------------- wbOuvert.Save wbOuvert.Close 'fermer fichier Set wbOuvert = Nothing ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Next k Application.ScreenUpdating = True Application.StatusBar = False End Sub La partie bloquante : wbOuvert.wsOuvert.Move After:=Sheets(Sheets.Count) wbOuvert.wsOuvert2.Move After:=Sheets(Sheets.Count) wbOuvert.wsOuvert.Name = "Performance - Potentiel" wbOuvert.wsOuvert2.Name = "Risques et impact départ" Un grand merci pour votre aide ...

ThauThème · Accepted Answer

Bonjour le fil, bonjour le forum,

Ton code modifié :

Sub AJOUT_DONNEES()
Dim wbOrigine As Workbook         'fichier actuel
Dim wsOrigine As Worksheet        'feuille actuelle 1
Dim wsOrigine2 As Worksheet        'feuille actuelle 2
Dim wbOuvert As Workbook        'fichier à ouvrir
Dim wsOuvert As Worksheet       'feuille du fichier à ouvrir
Dim vFichiers As Variant        'noms des fichiers
Dim i As Integer, k As Integer

Application.ScreenUpdating = False
Set wbOrigine = ThisWorkbook           'Fichier récapitulatif
Set wsOrigine = wbOrigine.Sheets("Onglet1")  'Onglet à copier
Set wsOrigine2 = wbOrigine.Sheets("Onglet2")  'Onglet à copier 2
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
If Not IsArray(vFichiers) Then
    MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
    Exit Sub
End If
' --- Boucle à travers les fichiers
For k = 1 To UBound(vFichiers)
    Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
    Set wbOuvert = Workbooks.Open(vFichiers(k), UpdateLinks:=False)
    wsOrigine.Copy After:=wbOuvert.Sheets(wbOuvert.Sheets.Count)
    wbOuvert.ActiveSheet.Name = "Performance - Potentiel"
    wsOrigine2.Copy After:=wbOuvert.Sheets(wbOuvert.Sheets.Count)
    wbOuvert.ActiveSheet.Name = "Risques et impact départ"
    wbOuvert.Close True
    Set wbOuvert = Nothing
Next k
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

ThauThème · Answer

Bonjour Simon et bienvenu, bonjour le forum,

Je ne pourrais pas joindre de fichier donc je vais essayer d'être le plus clair possible.

Créer un fichier exemple avec des données anonymes t'aurait pris moins de temps que pour écrire tout ton laïus...

On a donc un code qu'on ne peut pas tester et il faut te donner la réponse... C'est couillon !

Perso, j'aurais écrit comme ça (testé) :

wsOrigine.Copy After:=wbOuvert.Sheets(Sheets.Count)
ActiveSheet.Name = "Performance - Potentiel"
wsOrigine2.Copy After:=wbOuvert.Sheets(Sheets.Count)
ActiveSheet.Name = "Risques et impact départ"
wbOuvert.Close True
Set wbOuvert = Nothing

ric · Answer

Un meilleur a déjà répondu ... Je me retire ... ric...

ThauThème · Answer

Bonjour Ric, le fil, le forum, J'ai pu lire certaines de tes réponses. Le meilleur n'est pas forcément celui que tu penses.....

ric · Answer

Deux petits coquilles ... Au lieu de : Set wbOrigine = ThisWorkbook 'Fichier récapitulatif Set wsOrigine = wbOrigine.Sheets("Onglet1") 'Onglet à copier &lt;&lt; ici Set wsOrigine2 = wbOrigine.Sheets("Onglet2") 'Onglet à copier 2 &lt;&lt; et ici Écrire : Set wbOrigine = ThisWorkbook 'Fichier récapitulatif Set wsOrigine = ThisWorkbook.Sheets("Onglet1") 'Onglet à copier Set wsOrigine2 = ThisWorkbook.Sheets("Onglet2") 'Onglet à copier 2 Il reste à faire : Quand un fichier de destination est ouvert, avant d'insérer une feuille, faire une boucle afin de vérifier sur le nom des feuilles à ajouter n'existent pas déjà. Enfin, tu as placer cette instruction ... On Error Resume Next Il faut la fermer ... On Error GoTo 0 afin d'éviter d'éventuels petits désagréments. A+ ric...