Effectuer une boucle sur les onglets Résolu

Question

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

f894009 · Answer

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

Effectuer une boucle sur les onglets

1 réponse

Discussions similaires

Newsletters