Hente data fra andet regneark uden kæder

prøv med et: (stå i celle B3)
=vlookup(A3;'kildefilen $A$1:$B$15000;2;false)
På dansk hedder den vist lopslag, og så false til sidst.

Det synes jeg ikke virker og desuden opnår jeg vel kæder mellem de to filer ?

Der skal ikke være kæder.

Det må allerhelst fungere via VBA

Det burde virke, men jeg kan se at der skal stå FALSK til sidst i den danske version.
  Ja, det skaber kæder mellem de to filer, men VBA er ikke min stærke side, så kan det bruges er du velkommen ellers må du nok finde en VBA-mand

Følgende kode indlægges i "destinations-filen:
Ellers kan hele filen fremsendes ved at sende en mail til: pb@supertekst-it.dk

ThisWorkbook:
=============
Private Sub workbook_activate()
    Load UserForm1
    UserForm1.Show 0
End Sub


Userform1:
==========

Const UFnormalHøjde = 423.75
Const UFminiHøjde = 45

Const kildeSti = "C:\Documents and Settings\pb\Skrivebord\0305Mirac\Kilde.xls"      'tilpasses
Dim kXLS, kildeRækker
Dim aktuelleCelle As Range
Private Sub CommandButton1_Click()                  'OK - indsæt Kundenr | Navn
    If ActiveCell.Address <> "" Then
        ActiveCell = ListBox1
        Cells(ActiveCell.Row, ActiveCell.Column + 1) = ListBox1.List(UserForm1.ListBox1.ListIndex, 1)
        UserForm1.Height = UFminiHøjde
    End If
End Sub
Private Sub CommandButton2_Click()                  'annuller - luk Userform
    Unload UserForm1
End Sub
Private Sub CommandButton3_Click()                  'minimer / gendan Userformen
    With UserForm1
        If .Height = UFnormalHøjde Then
            .Height = UFminiHøjde
        Else
            .Height = UFnormalHøjde
        End If
    End With
End Sub
Private Sub ListBox1_Click()                        'kundelinie udpeget
    UserForm1.CommandButton1.SetFocus
End Sub
Private Sub UserForm_activate()
Rem formater kolonner i Listebox1
    UserForm1.ListBox1.ColumnCount = 2
    UserForm1.ListBox1.ColumnWidths = "50,100"      'bredde på de enkelte kolonner i Listbox1 - tilpasses evt.
   
Rem hent datafra Kildefil
    hentFraKildefil
End Sub
Private Sub hentFraKildefil()
    Set kXLS = CreateObject("Excel.application")
    With kXLS
        .Workbooks.Open kildeSti
       
        .ActiveWorkbook.Sheets(1).Activate
        kildeRækker = .ActiveCell.SpecialCells(xlLastCell).Row
        UserForm1.ListBox1.Clear
           
        For r = 2 To kildeRækker
            UserForm1.ListBox1.AddItem .Cells(r, 1)                                    'kundenr
            UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = .Cells(r, 2) 'kundenavn
        Next r
     
        .ActiveWorkbook.Close
        .Application.Quit
    End With
    Set kXLS = Nothing
End Sub

Hej Supertekst

Den er jo næsten magen til en du har hjulpet mig med før.

Men den gør jo brug af en userform... det er ikke meningen. man skal bare kunne stå i regnearket i celle A3 og skrive kundenr og derefter trykke enter.

Så står kundenr. i celle A3 og kundenavn i celle B3 hvis den kan finde værdien fra A3 i kildefilen.

Const kildeSti = "C:\Documents and Settings\pb\Skrivebord\0305Mirac\Kilde.xls"      'tilpasses
Dim kXLS, kildeRækker
Const kundeNrindtastesI = "A3:A3"                  'kan tilpasses
Private Sub worksheet_change(ByVal target As Excel.Range)
Dim kundeNavn As String

    If Not Intersect(target, Range(kundeNrindtastesI)) Is Nothing Then
        If Len(target) > 0 Then
            kundeNavn = søgKunde(target.Value)
                If kundeNavn <> "" Then
                Cells(target.Row, target.Column + 1) = kundeNavn
            Else
                MsgBox ("Kundenr. " + CStr(target.Value) + " kunne ikke findes!")
                Cells(target.Row, target.Column + 1) = ""
            End If
        End If
    End If
End Sub
Private Function søgKunde(knr)
    Set kXLS = CreateObject("Excel.application")
    With kXLS
        .Workbooks.Open kildeSti
       
        .ActiveWorkbook.Sheets(1).Activate
        kildeRækker = .ActiveCell.SpecialCells(xlLastCell).Row
         
        For r = 2 To kildeRækker
            If knr = .Cells(r, 1) Then
                søgKunde = .Cells(r, 2)
                lukObject
                Exit Function
            End If
        Next r
    End With
        lukObject
        søgKunde = ""
End Function
Private Sub lukObject()
    With kXLS
        .ActiveWorkbook.Close
        .Application.Quit
    End With
    Set kXLS = Nothing
End Sub

Som sædvanlig en særdeles god løsning Supertekst.

Lige en enkelt ting:

Kan man gøre så når man sletter kundenr i A3 så slettes kundenavn også i B3 ?

Og måske give en fejlmeddelelse hvis kundenr. ikke findes ?

Ups fejlmeddelelsen er der kan jeg se

Så er det kun det med at slette kundenr.

Const kildeSti = "C:\Documents and Settings\pb\Skrivebord\0305Mirac\Kilde.xls"      'tilpasses
Dim kXLS, kildeRækker
Const kundeNrindtastesI = "A3:A3"                  'kan tilpasses
Private Sub worksheet_change(ByVal target As Excel.Range)
Dim kundeNavn As String

    If Not Intersect(target, Range(kundeNrindtastesI)) Is Nothing Then
        If Len(target) > 0 Then
            kundeNavn = søgKunde(target.Value)
                If kundeNavn <> "" Then
                Cells(target.Row, target.Column + 1) = kundeNavn
            Else
                MsgBox ("Kundenr. " + CStr(target.Value) + " kunne ikke findes!")
                Cells(target.Row, target.Column + 1) = ""
            End If
        Else
                Cells(target.Row, target.Column + 1) = ""
        End If
    End If
End Sub
Private Function søgKunde(knr)
    Set kXLS = CreateObject("Excel.application")
    With kXLS
        .Workbooks.Open kildeSti
       
        .ActiveWorkbook.Sheets(1).Activate
        kildeRækker = .ActiveCell.SpecialCells(xlLastCell).Row
         
        For r = 2 To kildeRækker
            If knr = .Cells(r, 1) Then
                søgKunde = .Cells(r, 2)
                lukObject
                Exit Function
            End If
        Next r
    End With
        lukObject
        søgKunde = ""
End Function
Private Sub lukObject()
    With kXLS
        .ActiveWorkbook.Close
        .Application.Quit
    End With
    Set kXLS = Nothing
End Sub

Perfekt

Endnu engang tusind tak

Lige et lille spørgsmål hvis du altså ser det her Supertekst.

Hvis jeg markerer teksten/tallene i kolonnerne og sletter dem. Så kommer der en fejl og denne linie er markeret i vba editor:

If Len(Target) > 0 Then

Hvad går galt når jeg vil slette de data jeg har indtastet ?

Følger lige med..

Har lge et spg, da jeg mangler noget lignede.

Hvis man nu har kundernr. fra 1-9 og man indtaster 10, så er det rigtigt, at man ikke finder en kunde.

Men hvis man nu skriver navnet ud for nummer 10, kan man så få den til at tilføje kunden på kundelisten i den anden fil??