İki Private Sub Birleştirme

[Yesilyurtlu]

Evren Üstadıma ait:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H5:H500]) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Value > 20 Then Target.Offset(0, 1).Value = Target.Value - 20
If Target.Value > 20 Then Target.Offset(0, -1).Value = Target.Value - Target.Offset(0, 1).Value
If Target.Value <= 20 Then Target.Offset(0, -1).Value = Target.Value
End Sub

Korhan Üsdadıma ait:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [C2:C65536]) Is Nothing Then Exit Sub
Range("A2:C65536").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Son:
End Sub

Bu iki kodu birleştirmek istiyorum. Yardımcı olabilir misiniz

 

[Ömer]

Merhaba,

Bu şekilde denermisiniz..

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:C65536,H5:H500]) Is Nothing Then Exit Sub
If Target.Column = 8 Then
    On Error Resume Next
    If Target.Value > 20 Then Target.Offset(0, 1).Value = Target.Value - 20
    If Target.Value > 20 Then Target.Offset(0, -1).Value = Target.Value - Target.Offset(0, 1).Value
    If Target.Value <= 20 Then Target.Offset(0, -1).Value = Target.Value
Else
On Error GoTo Son
If Intersect(Target, [C2:C65536]) Is Nothing Then Exit Sub
    Range("A2:C65536").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Son:
End If
End Sub

.

 

[Yesilyurtlu]

Ömer Abi Teşekkür Ederim