Effectuer une boucle sur les onglets

Résolu/Fermé

Nonnoo Messages postés 25 Date d'inscription lundi 14 mars 2016 Statut Membre Dernière intervention 9 juin 2016 - 22 mars 2016 à 13:56
Nonnoo Messages postés 25 Date d'inscription lundi 14 mars 2016 Statut Membre Dernière intervention 9 juin 2016 - 23 mars 2016 à 10:19

Bonjour à tous,

Je suis en train de construire une macro qui me copie les valeurs d'un fichier et qui colle ses valeurs dans un onglet de mon fichier global.

Je m'explique, j'ai un dossier nommé Fichiers SX avec des classeurs excel nommés SX01,SX02,SX03... (jusqu'à 30).

J'ai un fichier global avec des onglet SX01,SX02... (qui sont identiques aux classeurs du fichier SX. Je souhaite avoir une macro qui m'efface les données de chaque onglet, et puis qui aille ouvrier mon dossier SX et qui copie les valeurs de chaque feuille et les colle dans mon fichier global en respectant l'onglet correspondant.
Je précise que ma macro se trouve dans l'onglet Macro de mon fichier global et que dans la colonne A2 de cette feuille il y a écrit "Fichiers SX" pour qu'il ouvre ce dossier là.

Dans mon code, je n'arrive pas à faire une boucle sur les onglets de mon fichier global pour qu'il efface toutes les données. De même je n'arrive pas à faire une boucle sur les onglets pour qu'il colle les données.

Savez-vous comment je dois m'y prendre svp ? Merci d'avance.

Voici mon 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

'Copie les données de SX01 et colle dans fichier global
Sheets("SX01").Select
Rows("7:7").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents

Sheets("Macro").Select
Range("A2").Select
While ActiveCell.Value <> ""
DossierDB = ActiveCell.Value
FichierDB = Dir(Chemin & "\" & DossierDB & "\*.xls")
Do Until FichierDB = ""
Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False

Rows("7:7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Windows(FichierMacro).Activate

Sheets("SX01").Select
Rows("7:7").Select
ActiveSheet.Paste

Workbooks(FichierDB).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
FichierDB = Dir

Loop
Wend

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

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox ("La compilation est terminée")

End Sub

A voir également:

Effectuer une boucle sur les onglets
Restaurer onglets chrome - Guide
Impossible d'effectuer l'opération car vous ne disposez pas des autorisations requises ✓ - Forum MacOS
Boucle cmd - Forum Programmation
Vous avez besoin d'une autorisation pour effectuer cette action - Guide
99 onglets ouverts android - Forum Mozilla Firefox

1 réponse

Réponse 1 / 1

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
23 mars 2016 à 08:52

Bonjour,

a essayer, j'ai laisse les activate et select meme si ce n'est pas top

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
    'dossier nommé Fichiers SX avec des classeurs excel nommés SX01,SX02,SX03... (jusqu'à 30).
    DossierDB = Sheets("Macro").Range("A2")
    If DossierDB <> "" Then
        FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
        Do Until FichierDB = ""
            Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).Copy

            Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
            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

Nonnoo Messages postés 25 Date d'inscription lundi 14 mars 2016 Statut Membre Dernière intervention 9 juin 2016
23 mars 2016 à 09:26

Bonjour,

Merci beaucoup pour votre réponse, cependant le code ne marche pas au moment du collage "Activesheet.paste", j'ai fait le mode pas à pas et c'est parce que le code copie dans un premier temps puis supprime les données du fichier global et enfin colle les nouvelles données.
Au moment où il supprime les anciennes données, on perd le collage d'avant...

Est-ce qu'on peut inverser la manip, d'abord effacer les données du fichier global puis ensuite copier coller les nouvelles données ?

Merci par avance

Nono

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > Nonnoo Messages postés 25 Date d'inscription lundi 14 mars 2016 Statut Membre Dernière intervention 9 juin 2016
Modifié par f894009 le 23/03/2016 à 09:39

Re,

Oui, sans probleme

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
    'dossier nommé Fichiers SX avec des classeurs excel nommés SX01,SX02,SX03... (jusqu'à 30).
    DossierDB = Sheets("Macro").Range("A2")
    If DossierDB <> "" Then
        FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")
        Do Until FichierDB = ""
            Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
            
            Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
            Rows("7:7").Select
            Range(Selection, Selection.End(xlDown)).Copy

            Windows(FichierMacro).Activate
            Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
            Rows("7:7").Select
            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

Nonnoo Messages postés 25 Date d'inscription lundi 14 mars 2016 Statut Membre Dernière intervention 9 juin 2016
23 mars 2016 à 10:19

MERCI BEAUCOUP C'est top !!!

Nono

Discussions similaires

Mon pc s'allume et s'éteint en boucle

Messagerie Outlook

Redémarrage en boucle Xiamo mi note 10

programme qui n'affiche pas le mot secret

Ma Freebox redémarre tout le temps

Discussions similaires

Newsletters