Option Explicit
Sub change_character()
Dim wb_new As Workbook
Dim lr As Long
Dim i As Long, j As Long
Dim path As String, fpath As String
Dim arr As Variant
Dim char_old As String, char_new As String
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
path = ThisWorkbook.path
arr = GetFileNames(path)
char_old = InputBox("Enter char finding:")
char_new = InputBox("Enter replace char:")
For i = 1 To UBound(arr) - 1
For Each wb_new In Workbooks
If wb_new.Name = arr(i) Then
lr = Workbooks(wb_new.Name).Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
For j = 2 To lr
Range("B" & j) = Replace(Range("B" & j), char_old, char_new)
Next j
Else
fpath = path & "\" & arr(i)
Set wb_new = Workbooks.Open(fpath)
lr = Workbooks(wb_new.Name).Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
For j = 2 To lr
Range("B" & j) = Replace(Range("B" & j), char_old, char_new)
Next j
wb_new.Close True
End If
Next wb_new
Next i
MsgBox "Finised."
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub
Function GetFileNames(ByVal FolderPath As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
Result(i) = MyFile.Name
i = i + 1
Next MyFile
GetFileNames = Result
End Function
