Option Explicit
Sub TARHIL()
Dim Sh As String
Dim i As Integer
Dim AA As Integer
'======================================================
Application.ScreenUpdating = False
Sheets("جنح").Range("A2:O1000").ClearContents
Sheets("مدنى").Range("A2:O1000").ClearContents
'يمكنك فى هذا الجزء اضافة اى شيت اخر جديد على نفس هذه الطريقة الموجودة
'======================================================
For i = 2 To Cells(10000, "A").End(xlUp).Row
Sh = Cells(i, "D").Value
AA = Sheets(Sh).Cells(10000, 1).End(xlUp).Row + 1
If AA < 2 Then AA = 2
On Error Resume Next
Range(Cells(i, "A"), Cells(i, "O")).Copy
Sheets(Sh).Range("A" & AA).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets(Sh).Cells(AA, "A").Value = Sheets(Sh).Cells(AA, "A").Row - 1
Next i
Application.ScreenUpdating = True
MsgBox "تم الترحيل بنجاح"
End Sub