Macro sur tous les fichiers d'un répertoire

Bonjour,

Etant novice en macro, j'appelle à votre aide.

Je dois faire un travail assez redondant dans une centaine de fichiers excel qui se situent dans un même dossier.

Je souhaite effacer le contenu des cellules qui ne sont pas en gras et qui se situent dans les colonnes I et J.

De plus, je souhaiterais changer la valeur de la cellule K2 (qui est fixe dans tous les fichiers) de 2022 à 2023.

Voici l'ébauche de code que j'ai:

Sub LoopThroughFiles()

    Dim StrFile, chemin As String
    chemin = "C:\Users\pel\Downloads\Test\"
    StrFile = Dir(chemin & "*.xlsx*")

    Application.ScreenUpdating = False

    Do While Len(StrFile) > 0

        With Workbooks.Open(chemin & StrFile)

Sub SuppNonGras()
'
' Suppression d'éléments qui ne sont pas en gras
'

'
Dim i As Integer

i = Range("I1048576").End(xlUp).Row

Do While i > 0

    Cells(i, 1).Select
    If Selection.Font.Bold = False Then
        Selection.Delete
    End If
    i = i - 1
Loop
End Sub

'Il me manque le code aussi pour remplacer la valeur de la cellule K2

        ActiveWorkbook.Save    'enregistrer les modifications
        ActiveWorkbook.Close  'Fermer 
       End With

    StrFile = Dir
    Loop
End Sub

Merci pour votre aide!

Pierre

Bonjour,

Ceci devrait faire l'affaire :

Sub LoopThroughFiles()
    Dim i As Integer
    Dim StrFile, chemin As String
    chemin = "C:\Users\pel\Downloads\Test\"
    StrFile = Dir(chemin & "*.xlsx*")

    Application.ScreenUpdating = False
    Do While Len(StrFile) > 0

        With Workbooks.Open(chemin & StrFile)
i = Range("I1048576").End(xlUp).Row
Range("I6:J" & i).SpecialCells(xlCellTypeConstants, 23).ClearContents 'cela va effacer le contenu de toutes les cellules n'ayant pas de formule dans ta plage.

'Il me manque le code aussi pour remplacer la valeur de la cellule K2
Range("K2") = Year(Date) + 1 'cela va mettre l'année N+1 dans la cellule K2. Si tu lances les macros l'an prochain, il faudra enlever le +1

ActiveWorkbook.Save    'enregistrer les modifications
ActiveWorkbook.Close  'Fermer
       End With

    StrFile = Dir
    Loop
End Sub