ضبط كود

[ناصر سعيد]

وجدت هذا الكود اريد من احد الاخوة الكرام تخفيفه ما امكن وشرح بعض اسطره

جزاكم الله خيرا

Sub kh_Copy_Formula()
On Error GoTo kh_Err
تصفير_محدد
kh_Application False

'=============================================
'kh_cFormula Range("شيت_الصف_الرابع!$c$2:$g$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$k$2:$L$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$p$2:$t$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$x$2:$y$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ac$2:$ag$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ak$2:$al$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ap$2:$at$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ay$2:$ba$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$bf$2:$bk$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$bo$2:$bp$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$bt$2:$bx$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ca$2:$cb$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ce$2:$ci$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$cl$2:$cm$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$cp$2:$ct$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$cw$2:$cx$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$da$2:$de$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$dh$2:$di$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$dl$2:$dr$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$dv$2:$dw$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$ea$2:$ek$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$em$2:$em$2"), 7, ورقة8.Range("b1")
'kh_cFormula Range("شيت_الصف_الرابع!$eo$2:$ew$2"), 7, ورقة8.Range("b1")
kh_cFormula Range("شيت_الصف_الرابع!$c$2:$ey$2"), 7, ورقة8.Range("b1")
kh_cFormula Range("شيت_الصف_الرابع!$eg$2:$eg$2"), 7, ورقة8.Range("b1")
kh_cFormula Range("شيت_الصف_الرابع!$ef$2:$ef$2"), 7, ورقة8.Range("b1")

'=============================================

kh_Err:
kh_Application True

If Err Then
    MsgBox "Err.Number : " & Err.Number
    Err.Clear
'    Else: MsgBox " تم نسخ المعادلات بنجاح", vbMsgBoxRight, "الحمدلله"
End If
End Sub

' MyRng   : الصف المخفي الذي يحوي المعادلات ملحوق باسم الورقة
' iRow    : اول صف للبيانات
' Lastrow : آخر صف للبيانات

Sub kh_cFormula(MyRng As Range, iRow As Integer, Lastrow As Long)
Dim col As Range
Dim R As Long
'========================
For Each col In MyRng.Cells
    If col.HasFormula Then
        For R = iRow To Lastrow
            With MyRng.Worksheet
                .Cells(R, col.Column).FormulaR1C1 = col.FormulaR1C1
                .Cells(R, col.Column).Value = .Cells(R, col.Column)
            End With
        Next R
    End If
Next
'========================
Set col = Nothing
End Sub

Sub kh_Application(ibol As Boolean)
With Application
    .ScreenUpdating = ibol
    .Calculation = IIf(ibol, -4105, -4135)
    .EnableEvents = ibol
End With
End Sub

جزاكم الله خيرا وبارك فيكم

[المسلم العربي]

ارفع ملف العمل حتى يساعدك الأعضاء الخبراء و شكراً

 

[ناصر سعيد]

هذا هو الملف

 

شرح كود.rar

===============

عرفت حزء احببت ان تشاركوني فيه

ان المعادله الموجوده بالصف التاني انسخها في الصف السابع بالعدد الموجود في الخليه بي 1

برجاء اكمال الشرح جزاكم الله خيرا

[ناصر سعيد]

18 ساعات مضت, ناصر سعيد said:

Sub kh_Application(ibol As Boolean) With Application .ScreenUpdating = ibol .Calculation = IIf(ibol, -4105, -4135) .EnableEvents = ibol End With End Sub

مامعنى هذه الارقام ومامعنى الكلمه الحمراء .. افادكم الله ؟

=======================

2 - يوجد 2 Sub  في الكود .. لماذا ؟

معذره ....  3 Sub ...  وليس 2 لماذا ؟

[خالد المصـــــــــــرى]

تم الحل جرب يا اخي

شرح كود.xlsm