Kod Birleştirme

[1Al2Ver]

Merhaba,

Aynı sayfadaki ;

1 nci Kod ;

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub
Set S1 = Sheets("DATALAR")
With Sheets("LİSTELER")
.Range("B3:B33").ClearContents
X = 3
For i = 2 To 750
If S1.Cells(i, "P") >= .Cells(1, "B") And S1.Cells(i, "P") <= .Cells(1, "D") Then .
.Cells(X, "B") = S1.Cells(i, "P")
X = X + 1
End If
Next
End With
End Sub

2 nci Kod ;

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [T1]) Is Nothing Then Exit Sub
    Call YASAKLAR
End Sub

kodlarını nasıl birleştire bilirim,

Teşekkür ederim.

 

[Korhan Ayhan]

Deneyin bakalım sorun çıkacak mı?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, X As Long, i As Long
    If Not Intersect(Target, Range("D1")) Is Nothing Then
        Set S1 = Sheets("DATALAR")
        With Sheets("LİSTELER")
            .Range("B3:B33").ClearContents
            X = 3
            For i = 2 To 750
                If S1.Cells(i, "P") >= .Cells(1, "B") And S1.Cells(i, "P") <= .Cells(1, "D") Then
                    .Cells(X, "B") = S1.Cells(i, "P")
                    X = X + 1
                End If
            Next
        End With
    ElseIf Not Intersect(Target, Range("T1")) Is Nothing Then
        Call YASAKLAR
    End If
End Sub

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Teşekkür ederim, denedim ve sorunsuz çalışıyor, elinize sağlık, çok sağ olun.

Saygılarımla.