Aynı sayfada 2 Private Sub Worksheet_Change

[sinnernekolens]

iyi günler,
Aynı sayfa içinde aşağıdaki kodları çalıştırmak istiyorum. yardımlarınızı rica ederim.

İKİNCİ ÇALIŞACAK KOD
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G5]) Is Nothing Then Exit Sub
son = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(Sheets("VERI").Range("B2:D" & son), Target) = 0 Then
[P3] = "!!DIKKAT!! Gemi sistemde kayıtlı değil."
MsgBox "!!DIKKAT!! Yazdığınız gemi sistemde kayıtlı değildir. " & Chr(10) & _
    "Eğer yeni bir gemiyse bilgileri girdikten sonra Kaydet düğmesine basınız.", vbOKOnly
GoTo 10
End If
[P3] = "!!DIKKAT!! Gemi sistemde bulundu, bilgileri getirildi."
[G6] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 2, 0)
[G7] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 3, 0)
[G8] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 4, 0)
[G9] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 5, 0)
[G10] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 6, 0)
[G11] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 7, 0)
10:
End Sub

İLK ÇALIŞACAK KOD
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
son = Sheets("FİRMALAR").Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(Sheets("FİRMALAR").Range("B2:B" & son), Target) = 0 Then
MsgBox "Yazdığınız Firma sistemde kayıtlı değildir. " & Chr(10) & _
    "Yeni Firma bilgisini yazarak Kaydet düğmesine basınız.", vbOKOnly
GoTo 10
End If
[B1] = WorksheetFunction.VLookup(Target, Sheets("FİRMALAR").Range("B2:B" & son), 2, 0)

10:
End Sub

 

[Ömer BARAN]

Merhaba.

Aşağıdaki gibi dener misiniz?
.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [[B][COLOR="Red"]B1, G5[/COLOR][/B]]) Is Nothing Then Exit Sub

If Target.Address(0, 0) = "B1" Then
[COLOR="Blue"]    son = Sheets("FİRMALAR").Cells(Rows.Count, "B").End(3).Row
    If WorksheetFunction.CountIf(Sheets("FİRMALAR").Range("B2:B" & son), Target) = 0 Then
        MsgBox "Yazdığınız Firma sistemde kayıtlı değildir. " & Chr(10) & _
            "Yeni Firma bilgisini yazarak Kaydet düğmesine basınız.", vbOKOnly
        Exit Sub
    End If
[B1] = WorksheetFunction.VLookup(Target, Sheets("FİRMALAR").Range("B2:B" & son), 2, 0)[/COLOR]
End If

If Target.Address(0, 0) = "G5" Then
[COLOR="DarkOrange"]    son = Sheets("VERI").Cells(Rows.Count, "B").End(3).Row
    If WorksheetFunction.CountIf(Sheets("VERI").Range("B2:D" & son), Target) = 0 Then
        [P3] = "!!DIKKAT!! Gemi sistemde kayıtlı değil."
        MsgBox "!!DIKKAT!! Yazdığınız gemi sistemde kayıtlı değildir. " & Chr(10) & _
            "Eğer yeni bir gemiyse bilgileri girdikten sonra Kaydet düğmesine basınız.", vbOKOnly
        Exit Sub
    End If
[P3] = "!!DIKKAT!! Gemi sistemde bulundu, bilgileri getirildi."
[G6] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 2, 0)
[G7] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 3, 0)
[G8] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 4, 0)
[G9] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 5, 0)
[G10] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 6, 0)
[G11] = WorksheetFunction.VLookup(Target, Sheets("VERI").Range("B2:H" & son), 7, 0)[/COLOR]
End If
End Sub

 

[sinnernekolens]

Ömer bey, Teşekkür ederim elinize sağlık.