Ouvrir plusieurs fichier Excel

Salut !

Je suis tout nouveau sur le forum et je voudrais savoir comment pouvons nous ouvrir un par un tous les fichiers d'un répertoire :

je m'explique, je suis en stage L2 :

J'ai la mise en forme à changer de tous les fichiers excel d'un dossier (Il y en a plus de 50).

J'ai déja creer la macro qui effectue ce changement de mise en forme.

Actuellement je n'arrive pas a créer la macro qui ouvre un fichier du dossier, exécute la macro de mise en forme, ferme le fichier et passe à l'autre ainsi de suite.Aussi je tiens a préciser que mes fichiers sont en mode protégé à l'ouverture

Pour ceux qui veulent voici ma macro mise en forme :

Sub VS()
'
' VS Macro
'

'
    Sheets("Days").Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft

    Sheets("Data").Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp

    Sheets("Voice").Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Range("H1:M1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Voice MO - Number of Calls"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "Voice MO - Chargeable Minutes"
    Range("J2:K2").Select
    ActiveCell.FormulaR1C1 = "Voice MO - Charged Minutes"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "Voice MO - Settlement GrossCharge- RPC"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "Voice MO - Settlement NetCharge - RPC"
    Range("N1:R1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "Voice MT - Number of Calls"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "Voice MT - Chargeable Minutes"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "Voice MT - Charged Minutes"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "Voice MT - Settlement GrossCharge- RPC"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "Voice MT - Settlement NetCharge - RPC"
    Range("G1:R1").Select
    Selection.Delete Shift:=xlUp
    Range("A1:F2").Select
    Selection.UnMerge
    Range("G2").Select
    Range("G2:R2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Columns("J:K").Select
    Range("J87695").Activate
    Selection.UnMerge
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft

    Sheets("SMS").Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Range("H1:K1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "SMS MO - Number of Calls"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "SMS MO - Settlement GrossCharge- RPC"
    Range("J2:K2").Select
    ActiveCell.FormulaR1C1 = "SMS MO - Settlement NetCharge - RPC"
    Range("L1:N1").Select
    ActiveWindow.ScrollColumn = 2
    ActiveCell.FormulaR1C1 = ""
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "SMS MT - Number of Calls"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "SMS MT - Settlement GrossCharge- RPC"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "SMS MT - Settlement NetCharge - RPC"
    Range("G1:N1").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollColumn = 1
    Range("A1:F2").Select
    Selection.UnMerge
    Range("G2").Select
    ActiveWindow.ScrollColumn = 2
    Range("G2:N2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("2:2").Select
    Range("B2").Activate
    Selection.Delete Shift:=xlUp
    Columns("J:K").Select
    Range("J150764").Activate
    Selection.UnMerge
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
End Sub

J'ai essayé avec ce code , mais en vain il ne s'éxecute pas

Sub test()

Dim repertoire As String
Dim wbook As Workbook
repertoire = "C:\Users\TOTO\Downloads\"

unFichier = Dir(repertoire & "*.xlsx")
While unFichier <> ""
    Set wbook = Workbooks.Open(repertoire & unFichier, , True)
    'code mise en forme
    wbook.Close False
    unFichier = Dir
Wend
End Sub

bonjour

en faisant ceci :

 wbook.Close False

la fermeture du fichier se fait sans enregistrer les modifications...... donc un peu logique que cela ne marche pas...

faudrait faire :

 wbook.Close True

par contre ton code est très très loin d'etre optimisé..... car un programmation il n'est pas du tout nécessaire de faire des select

fred

Exemple de simplification :

    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft

par

    Columns("A:A").Delete Shift:=xlToLeft
    Rows("1:2").Delete Shift:=xlUp
    Columns("J:J").Delete Shift:=xlToLeft

fred

Bonjour,

Merci d'avoir prêté attention à ma demande, mais le problème de viens pas vraiment de la mise en forme.

La macro ne s’exécute du tout pas , je ne vois pas pourquoi.

Bonsoir

ta fonction test fonctionne très bien chez moi.... mais une petite modif a faire aussi au niveau de l'ouverture car je n'avais pas fait attention tout a l'heure... tu ouvre le fichier en lecture seule donc pour l'ouvrir avec modif (remplacement de true par false dans l'instruction d'ouverture du fichier :

Sub test()

Dim repertoire As String
Dim wbook As Workbook
repertoire = "C:\Users\TOTO\Downloads\"

unFichier = Dir(repertoire & "*.xlsx")
While unFichier <> ""
    Set wbook = Workbooks.Open(repertoire & unFichier, , False)
    'code mise en forme

    wbook.Close False
    unFichier = Dir
Wend
End Sub

lance cette fonction en mode pas a pas (touche F8) pour voir ce qui se fait.... il faut cependant que le chemin soit correcte.... :

"C:\Users\TOTO\Downloads\"

Fred