XL 2019 Dupliquer un onglet identique de 200 classeurs dans un seul classeur avec 200 onglets

nicolino · 20 Janvier 2022

Bonsoir,

Tout est dans le titre (ou presque)

Je suis assez novice et c'est mon premier post.

J'aimerai trouver la bonne macro pour réaliser cette tâche très monotone manuellement (j'en suis à une centaine de classeurs et je craque à les ouvrir un à un...) qui consiste à dupliquer un onglet identique nommé "PHOTOS" de plusieurs classeurs "fichier n°1.xlsx" et "fichier n°2.xlsx" dans un seul classeur "Fichier complet.xlsx" avec tous les onglets à la suite mais renommés.

Exemple fichiers en PJ:

fichier n°1.xlsx
fichier n°2.xlsx
Fichier complet.xlsx

J'aimerai copier l'onglet PHOTOS du fichier n°1 et l'onglet PHOTOS du fichier n°2 dans le classeur Fichier complet en renommant les onglets avec le texte présent dans la cellule A2.

fichier n°1.xlsx

fichier n°2.xlsx

Fichier complet.xlsx

Un grand merci par avance pour votre aide

Nicolas

job75 · 21 Janvier 2022

Ce n'est plus le même sujet, normalement il faudrait créer une nouvelle discussion.

Mais comme c'est vraiment très classique voici le code pour créer les liens en colonne B :

VB:

Sub Liens()
Dim c As Range, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 'si une feuille n'existe pas
With ActiveSheet 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Range("B2:B" & .Rows.Count).Clear 'RAZ
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        Set w = Nothing
        Set w = Sheets("Photos du poteau n°" & c)
        .Hyperlinks.Add c(1, 2), "", "'" & w.Name & "'!A1"
    Next
End With
End Sub

job75 · 21 Janvier 2022

Bonsoir nicolino, bienvenue sur XLD,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Et sur le fichier Fichier complet(1).xlsm cliquez sur le bouton pour exécuter cette macro :

VB:

Sub Consolider()
Dim chemin$, fichier$, w As Worksheet
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---suppression des feuilles PHOTOS---
For Each w In Worksheets
    If UCase(w.Name) Like "PHOTOS*" Then w.Delete
Next
'---copie des fichiers---
While fichier <> ""
    With Workbooks.Open(chemin & fichier)
        Err = 0
        .Sheets("PHOTOS").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        If Err = 0 Then ThisWorkbook.ActiveSheet.Name = "PHOTOS " & Left(.Name, Len(.Name) - 5)
        .Close False
    End With
    fichier = Dir 'fichier suivant
Wend
Sheets(1).Select
End Sub

Avec 200 fichiers à ouvrir et copier la durée d'exécution sera assez longue.

Bonne nuit.

job75 · 21 Janvier 2022

Bonjour nicolino, le forum,

On remarquera que je n'utilise pas le texte situé en A2 pour nommer les feuilles.

En effet ce texte peut être erroné : sans le mot PHOTOS ou en doublon.

A+

nicolino · 21 Janvier 2022

job75 à dit:
Bonjour nicolino, le forum,

On remarquera que je n'utilise pas le texte situé en A2 pour nommer les feuilles.

En effet ce texte peut être erroné : sans le mot PHOTOS ou en doublon.

A+

Bonjour @job75 !

Un grand merci pour votre rapide réponse et la macro, c'est super efficace !

J'ai réussi à reproduire la macro sur mon fichier de travail mais en effet je n'arrive pas à renommer les onglets comme je le souhaitais, je cherche une solution...

En fait dans mes cellules A2, j'ai ce texte : "Photos du poteau n°XXXXX", ce que j'aurai aimé dans le nom de l'onglet.

Si vous avez un tuyau je suis preneur !

Merci

Bien à vous

job75 · 21 Janvier 2022

Je vois qu'il y a un onglet nommé "photos", avec ma macro du post #2 ce n'est pas possible car il est supprimé.

Maintenant si vous voulez absolument nommer l'onglet avec le texte en A2 utilisez :

VB:

Sub Consolider()
Dim chemin$, fichier$, w As Worksheet
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsx") '1er fichier du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---suppression des feuilles PHOTOS---
For Each w In Worksheets
    If UCase(w.Name) Like "PHOTOS*" Then w.Delete
Next
'---copie des fichiers---
While fichier <> ""
    With Workbooks.Open(chemin & fichier)
        .Sheets("PHOTOS").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.ActiveSheet.Name = .Sheets("PHOTOS").Range("A2")
        .Close False
    End With
    fichier = Dir 'fichier suivant
Wend
Sheets(1).Select
End Sub

Mais comme je l'ai dit cela peut être source d'erreurs.

nicolino · 21 Janvier 2022

Merci beaucoup @job75 !

Vous venez de me faire gagner quelques heures de "copier-coller" fastidieux !

Votre macro fonctionne à merveille

nicolino · 21 Janvier 2022

J'ai encore une interrogation mais je ne sais pas si je dois continuer à alimenter ce post ou créer un nouveau sujet ?

Maintenant que j'ai mes 200 onglets, je voudrais ajouter un lien hypertexte dans une colonne de mon tableau général qui pointe vers l'onglet correspondant (en fonction du numéro contenu dans la cellule A) :

Manuellement c'est assez long: clic droit, lien, dans ce document, puis trouver le bon onglet !

Je suis preneur d'une nouvelle idée de génie

Merci encore

job75 · 21 Janvier 2022

Ce n'est plus le même sujet, normalement il faudrait créer une nouvelle discussion.

Mais comme c'est vraiment très classique voici le code pour créer les liens en colonne B :

VB:

Sub Liens()
Dim c As Range, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 'si une feuille n'existe pas
With ActiveSheet 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Range("B2:B" & .Rows.Count).Clear 'RAZ
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        Set w = Nothing
        Set w = Sheets("Photos du poteau n°" & c)
        .Hyperlinks.Add c(1, 2), "", "'" & w.Name & "'!A1"
    Next
End With
End Sub

nicolino · 21 Janvier 2022

Encore une fois merci pour ce retour, j'ai terminé mon rapport qui m'aurait pris 3 jours de plus !

Je sais maintenant ce que je vais faire de mon compte CPF en 2022 --> trouver une formation VBA

Bon weekend

XL 2019 Dupliquer un onglet identique de 200 classeurs dans un seul classeur avec 200 onglets

nicolino

XLDnaute Nouveau

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

nicolino

XLDnaute Nouveau

job75

XLDnaute Barbatruc

nicolino

XLDnaute Nouveau

nicolino

XLDnaute Nouveau

job75

XLDnaute Barbatruc

nicolino

XLDnaute Nouveau

Discussions similaires