كيفية اضافة كود الى كود واجعلهم في كود واحد
Sub Names_Adjust()
'ضبط الأسماء قبل عملية الأبجدة
'--------------------------
Dim ch
Application.ScreenUpdating = False
With Range("E10:E1009")
For Each ch In Array("إ", "أ", "آ")
.Replace CStr(ch), "ا", , , True
Next
.Replace "ة", "ه", , , True
.Replace "ي ", "ى ", , , True
End With
Kill_Spaces
Application.ScreenUpdating = True
End Sub
مع الكود ده
Sub Kill_Spaces()
Dim sh As Worksheet, lr As Long, i As Long
Set sh = ThisWorkbook.ActiveSheet
lr = sh.Cells(Rows.Count, 5).End(xlUp).Row
'Application.ScreenUpdating = False
For i = 10 To lr
Do While InStr(sh.Cells(i, 5), " ") > 0
sh.Cells(i, 5).Value = Replace(sh.Cells(i, 5), " ", " ")
Loop
sh.Cells(i, 5).Value = Trim(sh.Cells(i, 5).Value)
Next i
'Application.ScreenUpdating = True
End Sub