Effectuer une boucle sur les onglets
Résolu
Nonnoo
Messages postés
25
Date d'inscription
Statut
Membre
Dernière intervention
-
Nonnoo Messages postés 25 Date d'inscription Statut Membre Dernière intervention -
Nonnoo Messages postés 25 Date d'inscription Statut Membre Dernière intervention -
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
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
- Vous devez disposer d'une autorisation pour effectuer cette action - Guide
- Restaurer les onglets chrome - Guide
- Nous limitons la fréquence de certaines actions que vous pouvez effectuer sur instagram ✓ - Forum Instagram
- Action limité sur instagram - Forum Instagram
- Télé samsung s'éteint et se rallume en boucle - Forum Téléviseurs
1 réponse
Bonjour,
a essayer, j'ai laisse les activate et select meme si ce n'est pas top
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
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
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 SubNono