Combine Two Private Sub Worksheet_Change

[Eid Mostafa]

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

_{الأخوة الأعزاء}

 

_{بالملف المرفق (BOOK1) كود لمحاذاة الأرقام بالمنتصف ، وبالملف الثانى (BOOK2) كود يقوم بتغيير إسم الشيت وفقاً للإسم المدخل بالخلية (D42).}

 

_{برجاء التكرم بدمج الكودان فى كود واحد.}

 

_{خالص شكرى وتقديرى}

 _أخوكم

_{عيد مصطفى}

Book1.rar

Book2.rar

[أبو حنــــين]

السلام عليكم

جرب هذا

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyRange As Range
If Target.Address = "$D$42" Then ActiveSheet.Name = Left(Target.Value, 10)
Set MyRange = Union([J5:J27], [L10:P27], [P40:P44])
If Intersect(Target, MyRange) Is Nothing Then Exit Sub
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
  
       For Each Ce In MyRange
       If IsNumeric(Ce) = False Then GoTo 1
With Ce
       .NumberFormat = "_(#,##0.00_);[Red]_((#,##0.00);_(--_);_(@_)"
        If .Value = 0 Then
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
        Else
       .HorizontalAlignment = xlRight
       .VerticalAlignment = xlCenter
  End If
  End With
1 Next Ce
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  
End Sub

[Eid Mostafa]

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

_{أخى العزيز / أبو حنين}

 

_{بالفعل أخى الحبيب هذا هو المطلوب بالفعل.}

 

     

 

_{خالص شكرى وتقديرى}

 _أخوك

_{عيد مصطفى}