ارجو المساعدة في تعديل الكود

[الشافعي]

عندي ملف اكسيل في كود وكل ما احول اضيف كود ثاني لا يقبل

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("U10")) Is Nothing Then

Exit Sub

End If

Select Case Range("U10").Value

Case Is = Range("W15").Value

copy_basic

copy_custom (15)

Case Is = Range("W16").Value

copy_basic

copy_custom (16)

Case Is = Range("W17").Value

copy_basic

copy_custom (17)

Case Is = Range("W18").Value

copy_basic

copy_custom (18)

Case Is = Range("W19").Value

copy_basic

copy_custom (19)

Case Is = Range("W20").Value

copy_basic

copy_custom (20)

Case Is = Range("W21").Value

copy_basic

copy_custom (21)

Case Is = Range("W22").Value

copy_basic

copy_custom (22)

Case Is = Range("W23").Value

copy_basic

copy_custom (23)

Case Is = Range("W24").Value

copy_basic

copy_custom (24)

Case Else

MsgBox "ÇáÈÑäÇãÌ ÛíÑ ãÍÏÏ ÓáÝÇ", vbCritical

End Select

End Sub

Sub copy_basic()

Set sh2 = Sheet2

sh2.Range("C11").Value = Range("B3").Value

sh2.Range("H12").Value = Range("K3").Value

sh2.Range("J14").Value = Range("L7").Value

sh2.Range("J16").Value = Range("L10").Value

sh2.Range("J18").Value = Range("B7").Value

sh2.Range("J20").Value = Range("B5").Value

sh2.Range("J22").Value = Range("J5").Value

sh2.Range("J50").Value = Range("U7").Value

sh2.Range("J52").Value = Range("U3").Value

sh2.Range("J54").Value = Range("U5").Value

sh2.Range("J56").Value = Range("U12").Value

End Sub

Sub copy_custom(nos As Integer)

Set sh2 = Sheet2

sh2.Range("J26").Value = Range("A" & nos).Value

sh2.Range("J28").Value = Range("B" & nos).Value

sh2.Range("J30").Value = Range("J" & nos).Value

sh2.Range("J32").Value = Range("K" & nos).Value

sh2.Range("J34").Value = Range("G" & nos).Value

sh2.Range("J36").Value = Range("R" & nos).Value

sh2.Range("J38").Value = Range("I" & nos).Value

sh2.Range("J40").Value = Range("O" & nos).Value

sh2.Range("J42").Value = Range("L" & nos).Value

sh2.Range("J44").Value = Range("D" & nos).Value

End Sub

وهذا الكود اللي عاوز اضيفه في مع الكود السابق

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A10:A12")) Is Nothing Then Exit Sub

If Range("A10") = 0 Then

Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = True

Else

Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = False

End If

If Range("A12") = 0 Then

Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = True

Else

Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = False

End If

End Sub

[الشافعي]

للرفع

[الشافعي]

جاري الكتابة وحل المشكلة 

[الشافعي]

لللرفع

[الشافعي]

للرفع

[احمد عبد الناصر]

السلام عليكم

 

اعتقد لا يمكن تكرار حدث للصفحة 

Private Sub Worksheet_Change(ByVal Target As Range)

جرب دمج الكودين 

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("U10")) Is Nothing Then
    Select Case Range("U10").Value
    Case Is = Range("W15").Value
    copy_basic
    copy_custom (15)
    Case Is = Range("W16").Value
    copy_basic
    copy_custom (16)
    Case Is = Range("W17").Value
    copy_basic
    copy_custom (17)
    Case Is = Range("W18").Value
    copy_basic
    copy_custom (18)
    Case Is = Range("W19").Value
    copy_basic
    copy_custom (19)
    Case Is = Range("W20").Value
    copy_basic
    copy_custom (20)
    Case Is = Range("W21").Value
    copy_basic
    copy_custom (21)
    Case Is = Range("W22").Value
    copy_basic
    copy_custom (22)
    Case Is = Range("W23").Value
    copy_basic
    copy_custom (23)
    Case Is = Range("W24").Value
    copy_basic
    copy_custom (24)
    Case Else
    MsgBox "C?E??C?? U?? ??II ???C", vbCritical
    End Select
ElseIf Not Intersect(Target, Range("A10:A12")) Is Nothing Then
    If Range("A10") = 0 Then
    Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = True
    Else
    Range("A15,A17,A19,a21,a23,a25,a27,a29").EntireRow.Hidden = False
    End If
    If Range("A12") = 0 Then
    Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = True
    Else
    Range("A16,A18,A20,a22,a24,a26,a28,a30").EntireRow.Hidden = False
    End If
Else
Exit Sub
End If

End Sub

تحياتي

[الشافعي]

شكرا استاذ احمد

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