formel til vb kode

Ja - opret en knap i kilde.xls og indlæg følgende kode:
Dim opslagsVærdi
Const slåOpFil = "d:\Eksperten\Splokit_2203\cha.xls"  'tilrettes!!!
Dim xls As Object
Private Sub CommandButton1_Click()
Dim ræk, kol, returkolonne
    opslagsVærdi = Cells(18, 3)
    returkolonne = 6
   
    resultat = Lopslag(returkolonne)
    If resultat <> -1 Then
        MsgBox ("Opslagsresultat: " + CStr(resultat))
    Else
        MsgBox ("Opslag lykkedes ikke")
    End If
    xls.Quit
   
    Set xls = Nothing
End Sub
Private Function Lopslag(returK)
    Set xls = CreateObject("excel.application")
   
    With xls
        .Workbooks.Open slåOpFil
   
        For ræk = 2 To 100
            If .Cells(ræk, 1) = opslagsVærdi Then
                Lopslag = .Cells(ræk, returK)
                Exit Function
            End If
        Next ræk
   
    End With
    Lopslag = -1
End Function

tilføjelse:

    With xls
        .Workbooks.Open slåOpFil
        .ActiveWorkbook.Sheets("Ark1").Activate  '<--------------------------

kan vi gøre den lidt bedre!?
så den søger efter den værdi som passer på værdien
Feks den skal søge på et navn, der hvor den henter værdien som skal retur er navnet michael buller jensen. men den værdi man vile slå op er michael B el Michael J el Michael b j.

D.v.s., at du i C:18 skriver michael B og får michael buller jensen "retur"?

Det kan godt lade sig gøre - vender tilbage senere!

Så er her et bud:

Forslag til din evt. videre "udbygning" - anvend en userform i Kildearket m/en tekstboks til indtastning af søgeord. En listbox til opsamling af evt. flere søgeresulatater, der matcher - således at der kan vælges. 

Dim opslagsVærdi
Const slåOpFil = "d:\Eksperten\Splokit_2203\cha.xls"
Dim xls As Object, points As Byte
Private Sub CommandButton1_Click()
Dim ræk, kol, returkolonne
    opslagsVærdi = LCase(Cells(18, 3))
    returkolonne = 6
   
    resultat = Lopslag(returkolonne)
    If resultat <> "" Then
        MsgBox ("Opslagsresultat: " + CStr(resultat))
    Else
        MsgBox ("Opslag lykkedes ikke")
    End If
    xls.Quit
   
    Set xls = Nothing
End Sub
Private Function Lopslag(returK)
Dim vTab(4) As String, f, count, p, oV As String, px

    oV = opslagsVærdi
    If Right(oV, 1) <> " " Then
        oV = oV + " "
    End If
   
    For f = 0 To 3
        vTab(f) = ""
    Next f
   
    points = 0
    px = 0
   
    count = -1
   
    While InStr(oV, " ") > 0
        p = InStr(oV, " ")
        If p > 0 Then
            count = count + 1
            vTab(count) = Left(oV, p - 1)
            oV = Mid(oV, p + 1)
        End If
    Wend

    Set xls = CreateObject("excel.application")
   
    With xls
        .Workbooks.Open slåOpFil
        .ActiveWorkbook.Sheets("Ark1").Activate
   
  Rem søg kun i kolonne F
        For ræk = 2 To 100
            For f = 0 To count
                p = InStr(LCase(.Cells(ræk, returK)), vTab(f))
                If p > 0 Then
                    If px = 0 Then
                        px = p
                        points = points + 1
                    Else
                        If p > px Then
                            points = points + 1
                            px = p
                        End If
                    End If
                End If
            Next f
           
            If points = count + 1 Then
                Lopslag = .Cells(ræk, returK)
                Exit Function
            Else
                px = 0
                points = 0
            End If
        Next ræk
   
    End With
    Lopslag = ""
End Function