combobox seçtiğimiz değere karşılık gelen değeri getir.

[chngrcn]

Forumun değerli üyeleri.

Ekteki çalışmamda, Sayfa1'de "G" sütununda hangi hücreye tıklarsak combobox açılıyor ve aşağıdaki kod sayesinde "Sayfa2"'deki "A" Sütunundaki veri doğrulama yöntemi ile listeletebiliyoruz.

Şimdi sizden yardımını istediğim konu,
Sayfa1'de "K" sütununa aynı şekilde veri doğrulama yöntemi ile listeletme seçeneği ekledim.
"K" sütunundaki combobox'tan hangi veriyi seçersem, Sayfa2'deki "C" Sütunundaki karşılığı gelen "Bertaraf Şirket Kodu" satırındaki veriyi;
Sayfa1'deki "L" Sütununa otomatik getirsin istiyorum. Bunu sağlayabilirmiyiz ? Yardımlarınızı rica eder, saygılar sunarım.

Not: Çözümün visual basic kod ile çözülmesini rica ediyorum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr
    
    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr
            End If
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
      
    
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13
            Application.ActiveCell.Offset(1, 0).Activate
    End Select
End Sub

 

[chngrcn]

Yardımlarınızı rica ediyorum.