سرعة الكود

[samycalls2020]

السلام عليكم ورحمة الله وبركاته

لدى كود جيد ويؤدى وظيفتة بدقه وهو يتعامل مع ثلاث أوراق
طلبى هو زيادة سرعته فهو يأخذ حوالى 7 ثوانى فى تنفيذ مهامه
شكراً لكم وبالتوفق

'كود جلب بيانات
Private Sub Worksheet_Change(ByVal Target As Range)
    If Cells(4, 2).Value = "ON" Then     ' لإيقاف وتشغيل الكود
    Dim ws As Worksheet, tbl As Long, tmp As Long, i As Long
    Dim n As String, Max As Long, ky As Boolean
    Max = 461
     If Not Intersect(Target, Range("D2,D4,B4,B7")) Is Nothing Then
    Set ws = Sheets("حساب الفوائد")
    Set SA = Sheets("مؤشر الفائدة")
    Set SB = Sheets("P")
 '------------------------------------------------------------------------------------------
'استخراج البيانات المطلوبة من بيانات الشهادات
    'On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    SA.Range("BH2") = 2
    
    'مسح البيانات من منطقة منطقة عرض البيانات
   SA.Range("D6:BC207").ClearContents
   ws.Range("DN26:FA225").ClearContents
   ws.Range("FG26:HF225").ClearContents
'--------------------------------------------------------------------------------------------------
    'فك البيانات
   Application.ScreenUpdating = False
  Dim sp As Variant, j&, lr&
   With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual
       .ErrorCheckingOptions.BackgroundChecking = True
   End With

   lr = ws.Cells(ws.Rows.Count, "DK").End(xlUp).Row
   
   For j = 26 To lr
        sp = Split(ws.Cells(j, "DK").Value2, "*")
        For i = LBound(sp) To UBound(sp)
           ws.Cells(j, i + 118).NumberFormat = "@"
            ws.Cells(j, i + 118).Value = sp(i)
        Next i
        Next j

    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
        .ErrorCheckingOptions.BackgroundChecking = False
    End With
 '-------------------------------------------------------------------------------------------
    'نسخ البيانات المفككة إلى إلى ورقة عرض البيانات
    Application.ScreenUpdating = False
    ws.Range("DN26:FA225").SpecialCells(xlCellTypeVisible).COPY
    ws.Range("FL26:GY225").PasteSpecial xlPasteValues
'---------------------------------------------------------------------------------------------
   'معادلة لضرب عدد الأشهر فى قيمة الفائدة الشهرية
   If SA.Range("BJ4") = 33 Then
   ws.Range("FL26:GY26") = ws.Range("FL25:GY25").Formula
   ws.Range("FL26:GY26").AutoFill Destination:=ws.Range("FL26:GY225"), Type:=xlFillDefault
    End If
'-----------------------------------------------------------------------------------------------
    Application.ScreenUpdating = False
     'معادلات لتكون صفحة العرض بلا معادلات
   If SA.Range("BJ4") = 33 Or SA.Range("BJ4") <> 33 Then
   ws.Range("FG26:FK225") = ws.Range("FG25:FK25").Formula
   ws.Range("FG26:FK225") = ws.Range("FG26:FK225").Value

    ws.Range("GZ26:HF225") = ws.Range("GZ24:HF24").Formula
    ws.Range("GZ26:HF225") = ws.Range("GZ26:HF225").Value
       
    SA.Range("D7:H7") = ws.Range("FG24:FK24").Value
    SA.Range("F4:H6") = ws.Range("FI21:FK23").Value
    SA.Range("AW6:BC7") = ws.Range("GZ22:HF23").Value
       
    End If
  ' -----------------------------------------------------------------------------------------------
    ws.Range("FL24:GY24").SpecialCells(xlCellTypeVisible).COPY
    SA.Range("I7:AV7").PasteSpecial xlPasteValues

    ws.Range("FG26:HF225").SpecialCells(xlCellTypeVisible).COPY
    SA.Range("D8:BC207").PasteSpecial xlPasteValues
  ' -----------------------------------------------------------------------------------------------
    Application.ScreenUpdating = False
    SB.Range("D8:L208").ClearContents
    SA.Range("D6:H207").SpecialCells(xlCellTypeVisible).COPY
    SB.Range("D7:H208").PasteSpecial xlPasteValues
    SA.Range("F4:H6").SpecialCells(xlCellTypeVisible).COPY
    SB.Range("F5:H7").PasteSpecial xlPasteValues
    
    ws.Range("HI25:HL225").SpecialCells(xlCellTypeVisible).COPY
    SB.Range("I8:L208").PasteSpecial xlPasteValues
    SA.Range("J5") = SA.Range("BQ5").Value
 ' -----------------------------------------------------------------------------------------------
   'لإخفاء الأعمده الفارغة
   Application.ScreenUpdating = False
  For s = 9 To 54
  If Cells(7, s).Value = "" Then
  Columns(s).EntireColumn.Hidden = True
  Else
  Columns(s).EntireColumn.Hidden = False
  End If
  Next s
  
  'إحتواء منسب الأعمده
  For s = 9 To 54
  If Cells(7, s).Value <> "" Then
  Columns(s).AutoFit
  End If
  Next s
 '------------------------------------------------------------------------------------------
        'لتغير الخطوط
       Application.ScreenUpdating = False
   If Sheets("مؤشر الفائدة").Range("B7") = 1 Then
   Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select
    With Selection.Font
        .Name = "Wingdings 3"
        .Size = 14
         Selection.HorizontalAlignment = xlCenter
           End With
           End If
       
   If Sheets("مؤشر الفائدة").Range("B7") = 2 Then
   Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        Selection.Font.Bold = True
        Selection.HorizontalAlignment = xlCenter
           End With
           End If
       
   If Sheets("مؤشر الفائدة").Range("B7") = 3 Then
   Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        Selection.HorizontalAlignment = xlCenter
             End With
             End If
    Application.ScreenUpdating = False
'-----------------------------------------------------------------------------------------
  ' لتلوين برواز الخلية ALP
      Application.ScreenUpdating = False
  If SA.Range("BJ6") = 5 Then
  SA.Range("AZ6").Select
  With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -10839132
       End With
       
        With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = 0
         End With
     
         End If
  If SA.Range("BJ6") <> 5 Then
  SA.Range("AZ6").Select
  With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
    .Color = 0
  With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -10839132
         End With
         End With
         End If
  ' ------------------------------------------------------------------------------------------------
    'P للتنسيق فى ورقة
    Sheets("P").Select
       Application.ScreenUpdating = False
     If Sheets("P").Range("I8") = "إجمــاليــات" Then
     Sheets("P").Range("$I$9:$J$208").Select
     With Selection.Font
     Selection.HorizontalAlignment = xlRight
     Selection.NumberFormat = "#,##0.00"
     Sheets("P").Range("$I$7:$J$208").Select
     Selection.Columns.AutoFit
     Sheets("P").Range("$K$8").Select
     Selection.Columns.Hidden = False
     End With
     Sheets("P").Range("D8").Select
     End If
     
      If Sheets("P").Range("I8") = "عدد" Then
     Sheets("P").Range("$I$9:$J$208").Select
     With Selection.Font
     Selection.HorizontalAlignment = xlCenter
     Selection.NumberFormat = "General"
     Sheets("P").Range("$I$8:$K$208").Select
     Selection.Columns.AutoFit
     Sheets("P").Range("$K$8").Select
     Selection.Columns.Hidden = True
     End With
     Sheets("P").Range("D8").Select
     End If

     Sheets("مؤشر الفائدة").Select
     Application.ScreenUpdating = Fals
     ActiveSheet.Shapes.Range(Array("مستطيل 10")).Select
     Application.ScreenUpdating = False
     If Selection.Text = "إخفاء الأعمدة" Then
          With Selection
          Selection.Text = "إظهار الأعمدة"
         .Font.Color = -4072739
          .ShapeRange.Fill.ForeColor.RGB = _
          RGB(15, 15, 15)
          .ShapeRange.Line.ForeColor.RGB = _
           RGB(169, 158, 103)
           End With
           End If
           End If
           Sheets("مؤشر الفائدة").Range("I7").Select
           

          End If
          End Sub