Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Boucle sur les onglets

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Nonno
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
N

Nonno

XLDnaute Nouveau
Bonjour à tous,

J'ai crée une macro qui me permet d'ouvrir un dossier cible, ouvrir les fichiers excels les uns après les autres et copier coller les données dans des onglets déjà pré établi d'un autre fichier excel. Cependant, il m'arrive parfois d'ajouter de nouveaux fichiers excels dans mon dossier cible sans rajouter d'onglet dans mon fichier excel. Je voudrais donc, par le biais d'une macro automatiser cette action. Càd : lorsqu'il ouvre un fichier excel et qu'il ne reconnait pas le nom de l'onglet comme l'un des noms appartenant à mon fichier excel, il crée l'onglet automatiquement en copiant sa feuille.

Je ne sais pas si j'ai été assez claire...
Merci d'avance pour votre aide

Cdt
Nono
Répo
 
Trier par date Trier par votes
Re : Boucle sur les onglets

Bonjour Nonno

Une petite fonction qui permet de savoir si une feuille existe

Code: 
Function exist(feuille As String, fichier As String) As Boolean
exist = True
On Error Resume Next
   Set x = Workbooks(fichier).Sheets(feuille)
   If Err.Number <> 0 Then exist = False
On Error GoTo 0
End Function
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Merci beaucoup Pierre Jean !
A la ligne : Set x = Workbooks(fichier).Sheets(feuille)
Je dois écrire le nom de chaque feuille ?

Ceci est mon code initial :
Code: 
Sub Bouton1_Cliquer()
    Dim FichierMacro As String
    Dim Chemin As String
    Dim DossierDB As String
    Dim FichierDB As String

    FichierMacro = ActiveWorkbook.Name
    Chemin = ActiveWorkbook.Path

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    DossierDB = Sheets("Macro").Range("A2")
    If DossierDB <> "" Then
        FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
        Do Until FichierDB = ""
            Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False

            Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
            
            Workbooks(FichierDB).Activate
            Rows("7:1000").Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveSheet.Paste

            Workbooks(FichierDB).Activate
            ActiveWorkbook.Close True
            Application.Wait (Now + TimeValue("00:00:01"))
            FichierDB = Dir
        Loop
    End If

    Sheets("Macro").Select
    ActiveCell.Offset(1, 0).Select

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox ("La compilation est terminée")

End Sub

Merci beaucoup

Nono
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Re

A tester:

Code: 
Sub Bouton1_Cliquer()
    Dim FichierMacro As String
    Dim Chemin As String
    Dim DossierDB As String
    Dim FichierDB As String


    FichierMacro = ActiveWorkbook.Name
    Chemin = ActiveWorkbook.Path


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    DossierDB = Sheets("Macro").Range("A2")
    If DossierDB <> "" Then
        FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
        Do Until FichierDB = ""
            Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
            
             If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierDB) Then
                FichierMacro.Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
            End If


            Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
                       
            Workbooks(FichierDB).Activate
            Rows("7:1000").Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveSheet.Paste


            Workbooks(FichierDB).Activate
            ActiveWorkbook.Close True
            Application.Wait (Now + TimeValue("00:00:01"))
            FichierDB = Dir
        Loop
    End If


    Sheets("Macro").Select
    ActiveCell.Offset(1, 0).Select


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


    MsgBox ("La compilation est terminée")


End Sub
Function exist(feuille As String, fichier As String) As Boolean
exist = True
On Error Resume Next
   Set x = Workbooks(fichier).Sheets(feuille)
   If Err.Number <> 0 Then exist = False
On Error GoTo 0
End Function
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Merci beaucoup !!!

Par contre j'ai un message d'erreur à cette partie :
Code: 
  If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierDB) Then
                FichierMacro.Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
            End If

C'est le FicierMacro qui ne marche pas je ne comprends pas pourquoi....
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Re

Teste:

Code: 
If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierDB) Then
    Workbooks(FichierMacro).Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
End If
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Merci beaucoup le code a l'air de mieux fonctionner cependant il y a un bug au tout dernier fichier excel qu'il ouvre il me met " impossible de renommer une feuille comme une autre feuille " or il n'y avait pas à renommer seulement à copier coller les valeurs : effectuer cette tâche :
Code: 
  Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
                       
            Workbooks(FichierDB).Activate
            Rows("7:1000").Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveSheet.Paste
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

J'ai modifié un peu le code mais ca ne marche toujours pas ca bug au niveau
Code: 
Workbooks(FichierDB).Activate
ca me met que l'indice n'appartient pas à la s

Voici mon code (désolée pour la longueur...) :
Code: 
Sub Bouton1_Cliquer()
    Dim FichierMacro As String
    Dim Chemin As String
    Dim DossierDB As String
    Dim FichierDB As String


    FichierMacro = ActiveWorkbook.Name
    Chemin = ActiveWorkbook.Path


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    DossierDB = Sheets("Macro").Range("A2")
    If DossierDB <> "" Then
        FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
        Do Until FichierDB = ""
            Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False

            Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
                       
            Workbooks(FichierDB).Activate
            Rows("7:1000").Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveSheet.Paste


            Workbooks(FichierDB).Activate
            ActiveWorkbook.Close True
            Application.Wait (Now + TimeValue("00:00:01"))
            FichierDB = Dir
            
            If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierDB) Then
            Workbooks(FichierDB).Activate
            Cells.Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveWindow.ScrollWorkbookTabs Position:=xlLast
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Paste
            ActiveWindow.DisplayGridlines = False
            ActiveWindow.Zoom = 85
            Application.CutCopyMode = False
            With Workbooks(FichierDB).ActiveSheet
            NomOnglet = .Name
            Windows(FichierMacro).Activate
            ActiveSheet.Name = NomOnglet
            End With
            'Workbooks(FichierMacro).Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
            End If
        Loop
    End If


    Sheets("Macro").Select
    ActiveCell.Offset(1, 0).Select


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


    MsgBox ("La compilation est terminée")


End Sub
Function exist(feuille As String, fichier As String) As Boolean
exist = True
On Error Resume Next
   Set x = Workbooks(fichier).Sheets(feuille)
   If Err.Number <> 0 Then exist = False
On Error GoTo 0
End Function

Encore un immense merci pour votre aide
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Re

Es-tu sur de cette ligne

Do Until FichierDB = ""

Ce ne serait pas plutot

Do Until FichierDB <> ""

Par ailleurs je crois que ceci serait plus judicieux:

If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierMacro) Then
Workbooks(FichierMacro).Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
End If
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Bonjour,

Lorsque je mets Do Until FichierDB <> "" ma macro va direct à End If et ne fais rien. Donc je pense plutôt que c'est Do Until FichierDB = ""

J'ai inséré ton code au mien mais ca bug lorsqu'il rencontre un fichier excel qui n'existait pas auparavant dans les onglets.
Voici le code :
Code: 
            Workbooks(FichierDB).Activate
            ActiveWorkbook.Close True
            Application.Wait (Now + TimeValue("00:00:01"))
            FichierDB = Dir
            
            If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierMacro) Then
            Workbooks(FichierMacro).Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
            Cells.Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveWindow.ScrollWorkbookTabs Position:=xlLast
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Paste
            ActiveWindow.DisplayGridlines = False
            ActiveWindow.Zoom = 85
            Application.CutCopyMode = False
            With Workbooks(FichierDB).ActiveSheet
            NomOnglet = .Name
            Windows(FichierMacro).Activate
            ActiveSheet.Name = NomOnglet
            End With
            End If
        Loop
    End If

Ca bug au niveau de la ligne : Windows(FichierMacro).Activate. Il me dise que "l'indice n'appartient pas à la sélection" ....

Merci
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Je viens de changer par Workbooks(FichierMacro).Activate du coup ca n' pas bugué. En revanche, pour le dernier fichier il bloque à : Workbooks(FichierMacro).Activate et ca m'écrit "argument ou appel de procédure incorrect". Je ne comprends pas...
 
Vote positif 0 Vote négatif
Re : Boucle sur les onglets

Re

Teste ceci

Code: 
Sub Bouton1_Cliquer()
    Dim FichierMacro As String
    Dim Chemin As String
    Dim DossierDB As String
    Dim FichierDB As String




    FichierMacro = ActiveWorkbook.Name
    Chemin = ActiveWorkbook.Path




    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    DossierDB = Sheets("Macro").Range("A2")
    If DossierDB <> "" Then
        FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
        Do Until FichierDB = ""
            Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
            
             If Not exist(Left(FichierDB, Len(FichierDB) - 4), FichierMacro) Then
                FichierMacro.Sheets.Add.Name = Left(FichierDB, Len(FichierDB) - 4)
            End If




           Workbooks(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
                       
            Workbooks(FichierDB).Activate
            Rows("7:1000").Select
            Selection.Copy
            Windows(FichierMacro).Activate
            ActiveSheet.Paste




            Workbooks(FichierDB).Activate
            ActiveWorkbook.Close True
            Application.Wait (Now + TimeValue("00:00:01"))
            FichierDB = Dir
        Loop
    End If




    Sheets("Macro").Select
    ActiveCell.Offset(1, 0).Select




    Application.ScreenUpdating = True
    Application.DisplayAlerts = True




    MsgBox ("La compilation est terminée")




End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Question Question
Microsoft 365 Cas réel - avec problème complexe sur de la prevision de match en evitant les doublons
Réponses
1
Affichages
822
Dock91
D
A
  • Question Question
Microsoft 365 Copie VBA d'un tableau présent et identique sur 12 onglets dans un autre onglet dont seules les lignes complétées sont copiées
Réponses
4
Affichages
695
AlexiaC
A
F
  • Question Question
Microsoft 365 copie de données colonne dans des nouveaux onglets
Réponses
5
Affichages
1 K
FCMLE44
F
Y
  • Résolu(e)
XL 2013 Ordre des onglets créés par rapport à une liste de départ
Réponses
8
Affichages
2 K
Yudlo
Y
D
  • Question Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
3 K
chris
F
  • Question Question
Microsoft 365 Insertion automatique de ligne sur plusieurs onglets à partir d’un onglet source
Réponses
0
Affichages
742
fredal
F
S
  • Question Question
XL 2013 [VBA] Modifier valeur dans un autre classeur excel en fonction de valeur
Réponses
0
Affichages
1 K
StagiaiireVannes
S
  • Question Question
XL 2016 Création de fichiers avec 3 onglets à partir d'une condition
Réponses
1
Affichages
566
bobjazz
B
  • Question Question
XL 2016 compléter un tableau dans un autre fichier suivant référence dossier
Réponses
7
Affichages
1 K
bidouill
B
T
  • Question Question
XL 2016 EXCEL VBA : empecher copier/coller et DragAndDrop sur les 2 onglets d'un fichier, mais pas sur d'autres fichier alors que le 1er fichier reste ouvert
Réponses
1
Affichages
1 K
Thibthib
T
J
  • Résolu(e)
Microsoft 365 Création d’onglets à partir d'une fiche type et d'une base de donnée
Réponses
14
Affichages
2 K
July35
J
B
  • Question Question
Comment copier par une macro une colonne et coller dans le tableau d'une autre feuille
Réponses
10
Affichages
5 K
bidouill
B
A
  • Question Question
XL 2016 extraire les lignes d'un onglet spécifique dans plusieurs fichier excel sans les ouvrir
Réponses
3
Affichages
2 K
Hasco
  • Question Question
Distribuer des modifications dans les noms des onglets
Réponses
8
Affichages
1 K
eriiic
G
  • Question Question
XL 2013 VBA - Exporter plusieurs onglets avec les macros VBA
Réponses
2
Affichages
2 K
GuestRC
G
  • Question Question
XL 2016 [Macro] Importer des données de plusieurs fichiers dans un seul fichier/plusieurs onglets
Réponses
0
Affichages
3 K
dj-spirit
G
  • Question Question
XL 2013 Boucle sur Commandbars
2
Réponses
24
Affichages
4 K
Roland_M
N
  • Question Question
Macro qui crée un onglet automatiquement à partir d'un fichier
Réponses
0
Affichages
815
Nonno
N
F
  • Question Question
XL 2010 Modification formule pour ajouter condition sur nom d'onglet
Réponses
2
Affichages
742
fb62840
F
E
  • Question Question
XL 2013 générer automatiquement des onglets dans excel 2013
Réponses
0
Affichages
566
esconde
E
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…