السلام عليكم  
	استخدم هذا الكود لإزالة الهمزات والمسافات الزائدة واستبدال (ى) بـ (ي) واستبدال (ة) بـ (ه)
 
Sub ReplaceChar()
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
   
   'هذا الكود لإزالة المسافات الزائدة فى الأسماء
Sheets("Teachers Data").Select
Sheets("Teachers Data").[B6:B324].Select
For Each cell In Selection
cell.Value = Application.WorksheetFunction.Trim(cell.Value)
'هذا الكود لاستبدال الحروف
    Sheets("Teachers Data").Range("B6:B324").Replace "أ", "ا"
    Sheets("Teachers Data").Range("B6:B324").Replace "إ", "ا"
    Sheets("Teachers Data").Range("B6:B324").Replace "آ", "ا"
    '-----------------
    Sheets("Teachers Data").Range("B6:B324").Replace "ة", "ه"
    Sheets("Teachers Data").Range("B6:B324").Replace "ى", "ي"
    Next
Sheets("Teachers Data").[B5].Select
MsgBox "ـ تم ضبط الاسماء بأستبدال ( أ - إ - آ )  بـ ( ا ) ـ" & _
vbCrLf & "ـ استبدال (ة) بـ (ه) || استبدال (ى) بـ (ي) ـ" & _
vbCrLf & "وإزالة المسافات الزائدة", vbInformation
End Sub
	 ---- 
	وهو يعمل لكنه بطئ ،  فهل هناك كود أفضل من ذلك  
	أو كيف يمكن التعديل عليه ليعمل بصورة أفضل