Trying to loop through all Excel files

Occasional Contributor

I am using a code which keeps the color and remove the conditional formatting. I have multiple files where i run this code for each file separately.


I am looking for a way that when i run the code it will popup the window for the selection of the folder. I will select the folder which contains multiple files then one by one code will run each file where it will keep the colors and remove the condition formatting then save and close the workbook.


I just tried to make these below code but really do not know how to develop further. Your help will be greatly appreciated.


Sub Format()
Dim ws As Worksheet
Dim mySel As Range, aCell As RangeSet ws = ThisWorkbook.Sheets("Data)
Set mySel = ws.UsedRange

For Each aCell In mySel
With aCell
.Font.FontStyle = .DisplayFormat.Font.FontStyle
End With
Next aCell


End Sub


And code to open the window.


  1. Sub Folder()
  2. Dim strFolder As String
  3. Dim strFile As String
  4. Dim wbk As Workbook
  5. Dim wsh As Worksheet
  6. Dim I As Long
  7. Dim xRg As Range
  9. With Application.FileDialog(4)
  10. If .Show Then
  11. strFolder = .SelectedItems(1)
  12. Else
  13. MsgBox "You haven't selected a folder!", vbExclamation
  14. Exit Sub
  15. End If
  16. End With
  17. Application.ScreenUpdating = False
  18. If Right(strFolder, 1) <> "\" Then
  19. strFolder = strFolder & "\"
  20. End If
  21. End Sub
  23. strFile = Dir(strFolder & "*.xls*")
  24. Do While strFile <> ""
  25. Set wbk = Workbooks.Open(strFolder & strFile)
  26. For I = 2 To wbk.Worksheets.Count


5 Replies
best response confirmed by AHelper (Occasional Contributor)


Try this - please test it on a copy of your folder first.

It will handle font name, font style, font color and fill color, but not fill effects, borders or number formatting. The code could be expanded for those.


Sub Folder()
    Dim strFolder As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim I As Long
    Dim xRg As Range
    With Application.FileDialog(4)
        If .Show Then
            strFolder = .SelectedItems(1)
            MsgBox "You haven't selected a folder!", vbExclamation
            Exit Sub
        End If
    End With

    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If

    Application.ScreenUpdating = False
    strFile = Dir(strFolder & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(strFolder & strFile)
        For Each wsh In wbk.Worksheets
            For Each xRg In wsh.UsedRange
                If xRg.FormatConditions.Count Then
                    xRg.Font.Name = xRg.DisplayFormat.Font.Name
                    xRg.Font.FontStyle = xRg.DisplayFormat.Font.FontStyle
                    xRg.Font.Color = xRg.DisplayFormat.Font.Color
                    If xRg.DisplayFormat.Interior.ColorIndex = xlColorIndexNone Then
                        xRg.Interior.ColorIndex = xlColorIndexNone
                        xRg.Interior.Color = xRg.DisplayFormat.Interior.Color
                    End If
                End If
            Next xRg
        Next wsh
        strFile = Dir
    Application.ScreenUpdating = True
End Sub
Thank you very much.
@Hans Vogelaar Sir there is one more problem that code should save and close all the files. Currently all workbooks are open when code complete the processing. Please look into this problem if it does not bother. Thanks.


Insert the following line below the line Next wsh:


        wbk.Close SaveChanges:=True
Thank you very much