هل يمكن اختصار الكود التالي ليصبح اخف

[gamalin]

الاخوة الافاضل الكود التالي يعمل جيدا ولكن مع تزايد البيانات يصبح بطئ جدا فهل يمكن اجراء اي تحسين عليه ليصبح اخف واسرع 
مرفق ملف 
في شيت itemout 
الزر new يقوم بالتشغيل 
ليتم ترحيل البيانات الى عدد اربعة شيتات اخرى 

Sub sale_m()
On Error Resume Next
Application.ScreenUpdating = False
 Sheets("perform").Unprotect Password:="m"
 Sheets("accmove").Unprotect Password:="m"
 Sheets("AccMove D").Unprotect Password:="m"
 Sheets("itemmove").Unprotect Password:="m"
 Sheets("itemout").Unprotect Password:="m"
           Sheets("Accmove").Rows("3:3").AutoFilter
           Sheets("AccMove D").Rows("4:4").AutoFilter
           Sheets("perform").Rows("4:4").AutoFilter
           Sheets("itemmove").Rows("4:4").AutoFilter
           Sheets("itemout").Rows("7:7").AutoFilter
Sheets("itemout").Select
    If Cells(2, 2) = "" Or Cells(5, 2) = "" Or Cells(8, 2) = "" Or Cells(2, 5) = "" Then
          MsgBox " Çßãá ÇáÈíÇäÇÊ , äæÚ ÇáÍÑßÉ , ßæÏ ÇáÚãíá , ßæÏ ÇáÕäÝ , ÇáÇÐä ÇáíÏæí "
            Range("b8").Select
           Sheets("Accmove").Rows("3:3").AutoFilter
           Sheets("AccMove D").Rows("4:4").AutoFilter
           Sheets("perform").Rows("4:4").AutoFilter
           Sheets("itemmove").Rows("4:4").AutoFilter
           Sheets("itemout").Rows("7:7").AutoFilter

Sheets("perform").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("itemmove").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("accmove").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("AccMove D").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("itemout").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("itemout").Select
       Exit Sub
    Else
  '  If Cells(2, 2) = "" Then MsgBox "ÇÎÊÑ äæÚ ÇáÍÑßÉ = ", 64, vbExclamation
  '  If Cells(5, 2) = "" Then MsgBox "ÇÏÎá ßæÏ ÇáãæÑÏ = ", 64, vbExclamation
  '  If Cells(8, 2) = "" Then MsgBox "ÇÏÎá ßæÏ ÇáÕäÝ = ", 64, vbExclamation
  '  If Cells(2, 5) = "" Then MsgBox "ÇÏÎá ÇáÇÐä ÇáíÏæí = ", 64, vbExclamation
For a = 8 To [b1000].End(xlUp).Row
         With Sheets("perform").[a50000].End(xlUp)
              .Offset(1, 0).FormulaR1C1 = "=if((r[-1]c)<>""ã"",(r[-1]c)+1,1)"
              .Offset(1, 1) = Cells(3, 2)
              .Offset(1, 2) = Cells(4, 2)
              .Offset(1, 3) = Cells(5, 2)
              .Offset(1, 4) = Cells(6, 2)
              .Offset(1, 5) = Cells(2, 5)
              .Offset(1, 6) = Cells(a, 2)
              .Offset(1, 7) = Cells(a, 3)
              .Offset(1, 😎 = Cells(a, 4)
              .Offset(1, 9) = Cells(a, 5)
         If Sheets("itemout").Cells(2, 2).Value <> "ãÑÏæÏÇÊ ãÈíÚÇÊ" Then
              .Offset(1, 10) = Cells(a, 6) * -1
           Else
              .Offset(1, 10) = Cells(a, 6)
        End If
              .Offset(1, 11) = Cells(a, 7)
              .Offset(1, 13).FormulaR1C1 = "=(RC[-3]*rc[-2])"
              .Offset(1, 15) = "no"
              .Offset(1, 21) = Cells(2, 2)
              .Offset(1, 25).FormulaR1C1 = "=IF(RC[-13]>0,RC[-13]*-1,RC[-15])"
              .Offset(1, 26).FormulaR1C1 = "=IF(RC[-14]>0,(RC[-16]+RC[-14])/RC[-16],0)"
              .Offset(1, 27).FormulaR1C1 = "=MONTH(RC[-25])"
End With
Next a
For a = 8 To [b1000].End(xlUp).Row
         With Sheets("AccMove D").[a50000].End(xlUp)
              .Offset(1, 0).FormulaR1C1 = "=row()-4"
              .Offset(1, 1) = Cells(3, 2)
              .Offset(1, 2) = Cells(4, 2)
              .Offset(1, 3) = Cells(5, 2)
              .Offset(1, 4) = Cells(6, 2)
              .Offset(1, 5) = Cells(2, 5)
              .Offset(1, 6) = Cells(a, 2)
              .Offset(1, 7) = Cells(a, 3)
              .Offset(1, 😎 = Cells(a, 4)
              .Offset(1, 9) = Cells(a, 5)
         If Sheets("itemout").Cells(2, 2).Value = "ãÑÏæÏÇÊ ãÈíÚÇÊ" Then
              .Offset(1, 10) = Cells(a, 6)
           Else
              .Offset(1, 10) = Cells(a, 6)
        End If
              .Offset(1, 11) = Cells(a, 7)
              .Offset(1, 13).FormulaR1C1 = "=(RC[-3]*rc[-2])"
              .Offset(1, 15) = "no"
              .Offset(1, 21) = Cells(2, 2)
              .Offset(1, 22).FormulaR1C1 = _
        "=IF(RC[-21]<>R[-1]C[-21],SUMIFS(C[-9],C[-21],RC[-21],C[-1],RC[-1]),0)"
         If Sheets("itemout").Cells(2, 2).Value = "ãÑÏæÏÇÊ ãÈíÚÇÊ" Then
              .Offset(1, 24).FormulaR1C1 = _
        "=IF(OR(RC[-3]<>R[-1]C[-3],RC[-23]<>R[-1]C[-23]),SUMIFS(C[-11],C[-23],RC[-23],C[-3],RC[-3]),0)"

           Else
              .Offset(1, 23).FormulaR1C1 = _
        "=IF(OR(RC[-2]<>R[-1]C[-2],RC[-22]<>R[-1]C[-22]),SUMIFS(C[-10],C[-22],RC[-22],C[-2],RC[-2]),0)"
        End If
              .Offset(1, 25).FormulaR1C1 = _
        "=SUMIFS(R4C[-2]:RC[-2],R4C[-22]:RC[-22],RC[-22])-SUMIFS(R4C[-1]:RC[-1],R4C[-22]:RC[-22],RC[-22])"
           '   .Offset(1, 26).FormulaR1C1 = "=IF(RC[-14]>0,(RC[-16]+RC[-14])/RC[-16],0)"
           '   .Offset(1, 27).FormulaR1C1 = "=MONTH(RC[-25])"
           '   .Offset(1, 28).FormulaR1C1 = "=year(RC[-26])"
End With
Next a
For a = 8 To [b1000].End(xlUp).Row
         With Sheets("itemmove").[a50000].End(xlUp)
              .Offset(1, 0).FormulaR1C1 = "=if((r[-1]c)<>""ã"",(r[-1]c)+1,1)"
              .Offset(1, 1) = Cells(a, 2)
              .Offset(1, 2) = Cells(a, 3)
              .Offset(1, 3) = Cells(a, 4)
              .Offset(1, 4) = Cells(a, 5)
              .Offset(1, 5) = Cells(2, 2)
              .Offset(1, 6) = Cells(3, 2)
              .Offset(1, 7) = Cells(2, 5)
         If Sheets("itemout").Cells(2, 2).Value <> "ãÑÏæÏÇÊ ãÈíÚÇÊ" Then
              .Offset(1, 9) = Cells(a, 11)
            Else
              .Offset(1, 😎 = Cells(a, 11)
         End If
              .Offset(1, 10).FormulaR1C1 = _
                            "=SUMIFS(R5C[-2]:RC[-2],R5C[-9]:RC[-9],RC[-9])-SUMIFS(R5C[-1]:RC[-1],R5C[-9]:RC[-9],RC[-9])"
              .Offset(1, 11) = Cells(5, 2)
              .Offset(1, 12) = Cells(a, 13)
              .Offset(1, 14) = Cells(4, 2)
End With

Next a
For a = 8 To [b1000].End(xlUp).Row

         With Sheets("accmove").[a50000].End(xlUp)
              .Offset(1, 0).FormulaR1C1 = "=row()-3"
              .Offset(1, 1) = Cells(5, 2)
              .Offset(1, 2) = Cells(6, 2)
              .Offset(1, 4) = Cells(3, 2)
              .Offset(1, 5) = Cells(2, 5)
              .Offset(1, 6) = Cells(4, 2)
         If Sheets("itemout").Cells(2, 2).Value <> "ãÑÏæÏÇÊ ãÈíÚÇÊ" Then
              .Offset(1, 7) = Cells(36, 😎
             Else
              .Offset(1, 😎 = Cells(36, 😎
         End If
              .Offset(1, 9).FormulaR1C1 = _
                           "=SUMIFS(R4C[-2]:RC[-2],R4C[-8]:RC[-8],RC[-8])-SUMIFS(R4C[-1]:RC[-1],R4C[-8]:RC[-8],RC[-8])"
              .Offset(1, 10) = Cells(a, 6)
              .Offset(1, 11) = Cells(34, 😎
              .Offset(1, 13) = Cells(35, 😎
            '  .Offset(1, 14).FormulaR1C1 = "=VLOOKUP(RC[-13],acc!C[-13]:C[-3],8,FALSE)"
              .Offset(1, 15) = Cells(2, 2)
              .Offset(1, 18) = Cells(5, 3)
              .Offset(1, 19).FormulaR1C1 = "=MONTH(RC[-13])"
End With
Next a
'For a = 8 To [b1000].End(xlUp).Row
     Sheets("itemout").Select
    ActiveSheet.Range("$A$7:$H$40").AutoFilter Field:=2, Criteria1:="<>"
    Range("A1:H36").Select
'    Selection.PrintOut Copies:=2, Collate:=True

'Application.Run "sale_clr"
End If
           Sheets("Accmove").Rows("3:3").AutoFilter
           Sheets("perform").Rows("4:4").AutoFilter
           Sheets("itemmove").Rows("4:4").AutoFilter
           Sheets("itemout").Rows("7:7").AutoFilter

Sheets("perform").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("itemmove").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("accmove").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("AccMove D").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
Sheets("itemout").Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End Sub

officena test.xlsm

[أبوعيد]

تفضل جرب هذا من الذكاء الاصطناع

==============
Sub sale_m_Optimized()
    Dim wsItemOut As Worksheet, wsPerform As Worksheet, wsAccMove As Worksheet
    Dim wsAccMoveD As Worksheet, wsItemMove As Worksheet
    Dim lastRow As Long, i As Long, nRows As Long
    Dim dataArr As Variant
    Dim performArr As Variant, accMoveDArr As Variant
    Dim itemMoveArr As Variant, accMoveArr As Variant
    Dim docType As String, isReturn As Boolean
    Dim performStart As Long, accMoveDStart As Long
    Dim itemMoveStart As Long, accMoveStart As Long
    
    On Error GoTo CleanUp
    
    ' ═══════════════════════════════════════
    ' إيقاف كل ما يبطئ التنفيذ
    ' ═══════════════════════════════════════
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' ═══════════════════════════════════════
    ' تعريف الأوراق (مرة واحدة فقط)
    ' ═══════════════════════════════════════
    Set wsItemOut = ThisWorkbook.Sheets("itemout")
    Set wsPerform = ThisWorkbook.Sheets("perform")
    Set wsAccMove = ThisWorkbook.Sheets("accmove")
    Set wsAccMoveD = ThisWorkbook.Sheets("AccMove D")
    Set wsItemMove = ThisWorkbook.Sheets("itemmove")
    
    ' ═══════════════════════════════════════
    ' فك الحماية
    ' ═══════════════════════════════════════
    wsPerform.Unprotect Password:="m"
    wsAccMove.Unprotect Password:="m"
    wsAccMoveD.Unprotect Password:="m"
    wsItemMove.Unprotect Password:="m"
    wsItemOut.Unprotect Password:="m"
    
    ' إيقاف الفلاتر
    On Error Resume Next
    wsPerform.Rows("4:4").AutoFilter
    wsAccMoveD.Rows("4:4").AutoFilter
    wsAccMove.Rows("3:3").AutoFilter
    wsItemMove.Rows("4:4").AutoFilter
    wsItemOut.Rows("7:7").AutoFilter
    On Error GoTo CleanUp
    
    ' ═══════════════════════════════════════
    ' التحقق من البيانات الإلزامية
    ' ═══════════════════════════════════════
    With wsItemOut
        If .Cells(2, 2) = "" Or .Cells(5, 2) = "" Or .Cells(8, 2) = "" Or .Cells(2, 5) = "" Then
            MsgBox "أكمل البيانات: نوع الحركة, كود العميل, كود الصنف, الإذن اليدوي"
            .Range("B8").Select
            GoTo CleanUp
        End If
    End With
    
    ' ═══════════════════════════════════════
    ' قراءة القيم الثابتة مرة واحدة
    ' ═══════════════════════════════════════
    docType = wsItemOut.Cells(2, 2).Value
    isReturn = (docType = "مردودات مبيعات")
    
    ' ═══════════════════════════════════════
    ' حساب عدد صفوف البيانات
    ' ═══════════════════════════════════════
    lastRow = wsItemOut.Cells(wsItemOut.Rows.Count, 2).End(xlUp).Row
    If lastRow < 8 Then GoTo CleanUp
    nRows = lastRow - 7
    
    ' قراءة كل بيانات المصدر في مصفوفة واحدة (B8:M...)
    dataArr = wsItemOut.Range("B8:M" & lastRow).Value
    
    ' ═══════════════════════════════════════
    ' حساب صف البداية في كل شيت (مرة واحدة)
    ' ═══════════════════════════════════════
    performStart = wsPerform.Cells(wsPerform.Rows.Count, 1).End(xlUp).Row + 1
    accMoveDStart = wsAccMoveD.Cells(wsAccMoveD.Rows.Count, 1).End(xlUp).Row + 1
    itemMoveStart = wsItemMove.Cells(wsItemMove.Rows.Count, 1).End(xlUp).Row + 1
    accMoveStart = wsAccMove.Cells(wsAccMove.Rows.Count, 1).End(xlUp).Row + 1
    
    ' ═══════════════════════════════════════
    ' تهيئة المصفوفات للشيتات الأربعة
    ' ═══════════════════════════════════════
    ReDim performArr(1 To nRows, 1 To 21)   ' B:V
    ReDim accMoveDArr(1 To nRows, 1 To 21)  ' B:V
    ReDim itemMoveArr(1 To nRows, 1 To 14)  ' B:O
    ReDim accMoveArr(1 To nRows, 1 To 19)   ' B:T
    
    ' ═══════════════════════════════════════
    ' حلقة واحدة فقط لملء المصفوفات الأربع
    ' ═══════════════════════════════════════
    For i = 1 To nRows
        
        ' ═══ شيت perform (أعمدة B:V) ═══
        performArr(i, 1) = wsItemOut.Cells(3, 2).Value   ' B
        performArr(i, 2) = wsItemOut.Cells(4, 2).Value   ' C
        performArr(i, 3) = wsItemOut.Cells(5, 2).Value   ' D
        performArr(i, 4) = wsItemOut.Cells(6, 2).Value   ' E
        performArr(i, 5) = wsItemOut.Cells(2, 5).Value   ' F
        performArr(i, 6) = dataArr(i, 1)                 ' G (من B)
        performArr(i, 7) = dataArr(i, 2)                 ' H (من C)
        performArr(i, 😎 = dataArr(i, 3)                 ' I (من D)
        performArr(i, 9) = dataArr(i, 4)                 ' J (من E)
        ' K: الكمية (سالب إذا لم يكن مردود)
        If Not isReturn Then
            performArr(i, 10) = dataArr(i, 5) * -1
        Else
            performArr(i, 10) = dataArr(i, 5)
        End If
        performArr(i, 11) = dataArr(i, 6)                ' L (من G)
        performArr(i, 15) = "no"                         ' P
        performArr(i, 21) = docType                      ' V
        
        ' ═══ شيت AccMove D (أعمدة B:V) ═══
        accMoveDArr(i, 1) = wsItemOut.Cells(3, 2).Value  ' B
        accMoveDArr(i, 2) = wsItemOut.Cells(4, 2).Value  ' C
        accMoveDArr(i, 3) = wsItemOut.Cells(5, 2).Value  ' D
        accMoveDArr(i, 4) = wsItemOut.Cells(6, 2).Value  ' E
        accMoveDArr(i, 5) = wsItemOut.Cells(2, 5).Value  ' F
        accMoveDArr(i, 6) = dataArr(i, 1)                ' G
        accMoveDArr(i, 7) = dataArr(i, 2)                ' H
        accMoveDArr(i, 😎 = dataArr(i, 3)                ' I
        accMoveDArr(i, 9) = dataArr(i, 4)                ' J
        accMoveDArr(i, 10) = dataArr(i, 5)               ' K
        accMoveDArr(i, 11) = dataArr(i, 6)               ' L
        accMoveDArr(i, 15) = "no"                        ' P
        accMoveDArr(i, 21) = docType                     ' V
        
        ' ═══ شيت itemmove (أعمدة B:O) ═══
        itemMoveArr(i, 1) = dataArr(i, 1)                ' B
        itemMoveArr(i, 2) = dataArr(i, 2)                ' C
        itemMoveArr(i, 3) = dataArr(i, 3)                ' D
        itemMoveArr(i, 4) = dataArr(i, 4)                ' E
        itemMoveArr(i, 5) = docType                      ' F
        itemMoveArr(i, 6) = wsItemOut.Cells(3, 2).Value  ' G
        itemMoveArr(i, 7) = wsItemOut.Cells(2, 5).Value  ' H
        ' I/J: نفس المنطق الأصلي (أعمدة مختلفة حسب نوع الحركة)
        If Not isReturn Then
            itemMoveArr(i, 9) = dataArr(i, 10)           ' J (من K في المصدر)
        Else
            itemMoveArr(i, 😎 = dataArr(i, 10)           ' I (من K في المصدر)
        End If
        itemMoveArr(i, 11) = wsItemOut.Cells(5, 2).Value ' L
        itemMoveArr(i, 12) = dataArr(i, 12)              ' M (من M في المصدر)
        itemMoveArr(i, 14) = wsItemOut.Cells(4, 2).Value ' O
        
        ' ═══ شيت accmove (أعمدة B:T) ═══
        accMoveArr(i, 1) = wsItemOut.Cells(5, 2).Value   ' B
        accMoveArr(i, 2) = wsItemOut.Cells(6, 2).Value   ' C
        accMoveArr(i, 4) = wsItemOut.Cells(3, 2).Value   ' E
        accMoveArr(i, 5) = wsItemOut.Cells(2, 5).Value   ' F
        accMoveArr(i, 6) = wsItemOut.Cells(4, 2).Value   ' G
        ' H/I: نفس المنطق الأصلي
        If Not isReturn Then
            accMoveArr(i, 7) = wsItemOut.Cells(36, 8).Value  ' H
        Else
            accMoveArr(i, 😎 = wsItemOut.Cells(36, 8).Value  ' I
        End If
        accMoveArr(i, 10) = dataArr(i, 5)                ' K
        accMoveArr(i, 11) = wsItemOut.Cells(34, 8).Value ' L
        accMoveArr(i, 13) = wsItemOut.Cells(35, 8).Value ' N
        accMoveArr(i, 15) = docType                      ' P
        accMoveArr(i, 18) = wsItemOut.Cells(5, 3).Value  ' S
        
    Next i
    
    ' ═══════════════════════════════════════
    ' كتابة المصفوفات دفعة واحدة (أسرع بـ 100 مرة)
    ' ═══════════════════════════════════════
    wsPerform.Range("B" & performStart & ":V" & performStart + nRows - 1).Value = performArr
    wsAccMoveD.Range("B" & accMoveDStart & ":V" & accMoveDStart + nRows - 1).Value = accMoveDArr
    wsItemMove.Range("B" & itemMoveStart & ":O" & itemMoveStart + nRows - 1).Value = itemMoveArr
    wsAccMove.Range("B" & accMoveStart & ":T" & accMoveStart + nRows - 1).Value = accMoveArr
    
    ' ═══════════════════════════════════════
    ' كتابة الصيغ دفعة واحدة لكل نطاق
    ' ═══════════════════════════════════════
    
    ' --- perform ---
    With wsPerform
        .Range("A" & performStart & ":A" & performStart + nRows - 1).FormulaR1C1 = "=IF((R[-1]C)<>""م"",(R[-1]C)+1,1)"
        .Range("N" & performStart & ":N" & performStart + nRows - 1).FormulaR1C1 = "=(RC[-3]*RC[-2])"
        .Range("Z" & performStart & ":Z" & performStart + nRows - 1).FormulaR1C1 = "=IF(RC[-13]>0,RC[-13]*-1,RC[-15])"
        .Range("AA" & performStart & ":AA" & performStart + nRows - 1).FormulaR1C1 = "=IF(RC[-14]>0,(RC[-16]+RC[-14])/RC[-16],0)"
        .Range("AB" & performStart & ":AB" & performStart + nRows - 1).FormulaR1C1 = "=MONTH(RC[-25])"
    End With
    
    ' --- AccMove D ---
    With wsAccMoveD
        .Range("A" & accMoveDStart & ":A" & accMoveDStart + nRows - 1).FormulaR1C1 = "=ROW()-4"
        .Range("N" & accMoveDStart & ":N" & accMoveDStart + nRows - 1).FormulaR1C1 = "=(RC[-3]*RC[-2])"
        .Range("W" & accMoveDStart & ":W" & accMoveDStart + nRows - 1).FormulaR1C1 = "=IF(RC[-21]<>R[-1]C[-21],SUMIFS(C[-9],C[-21],RC[-21],C[-1],RC[-1]),0)"
        
        If isReturn Then
            .Range("Y" & accMoveDStart & ":Y" & accMoveDStart + nRows - 1).FormulaR1C1 = "=IF(OR(RC[-3]<>R[-1]C[-3],RC[-23]<>R[-1]C[-23]),SUMIFS(C[-11],C[-23],RC[-23],C[-3],RC[-3]),0)"
        Else
            .Range("X" & accMoveDStart & ":X" & accMoveDStart + nRows - 1).FormulaR1C1 = "=IF(OR(RC[-2]<>R[-1]C[-2],RC[-22]<>R[-1]C[-22]),SUMIFS(C[-10],C[-22],RC[-22],C[-2],RC[-2]),0)"
        End If
        
        .Range("Z" & accMoveDStart & ":Z" & accMoveDStart + nRows - 1).FormulaR1C1 = "=SUMIFS(R4C[-2]:RC[-2],R4C[-22]:RC[-22],RC[-22])-SUMIFS(R4C[-1]:RC[-1],R4C[-22]:RC[-22],RC[-22])"
    End With
    
    ' --- itemmove ---
    With wsItemMove
        .Range("A" & itemMoveStart & ":A" & itemMoveStart + nRows - 1).FormulaR1C1 = "=IF((R[-1]C)<>""م"",(R[-1]C)+1,1)"
        .Range("K" & itemMoveStart & ":K" & itemMoveStart + nRows - 1).FormulaR1C1 = "=SUMIFS(R5C[-2]:RC[-2],R5C[-9]:RC[-9],RC[-9])-SUMIFS(R5C[-1]:RC[-1],R5C[-9]:RC[-9],RC[-9])"
    End With
    
    ' --- accmove ---
    With wsAccMove
        .Range("A" & accMoveStart & ":A" & accMoveStart + nRows - 1).FormulaR1C1 = "=ROW()-3"
        .Range("J" & accMoveStart & ":J" & accMoveStart + nRows - 1).FormulaR1C1 = "=SUMIFS(R4C[-2]:RC[-2],R4C[-8]:RC[-8],RC[-8])-SUMIFS(R4C[-1]:RC[-1],R4C[-8]:RC[-8],RC[-8])"
        .Range("T" & accMoveStart & ":T" & accMoveStart + nRows - 1).FormulaR1C1 = "=MONTH(RC[-13])"
    End With
    
    ' ═══════════════════════════════════════
    ' تصفية itemout
    ' ═══════════════════════════════════════
    wsItemOut.Range("A7:H40").AutoFilter Field:=2, Criteria1:="<>"
    
CleanUp:
    ' ═══════════════════════════════════════
    ' إعادة الحماية والإعدادات (دائماً تنفذ)
    ' ═══════════════════════════════════════
    On Error Resume Next
    wsPerform.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    wsItemMove.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    wsAccMove.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    wsAccMoveD.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    wsItemOut.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub