Hente data fra eksterne XLS fil.

Denne kode kan hente data i anden fil, med du bliver nød til at have en knap til opdatering. Vi mangler at få at vide hvilke koloner til og fra ?

Filename = InputBox("Indtast filnavn:", "Filnavn", "test.xls")
Set ws2 = ActiveSheet
Set wb1 = Workbooks.Open(Filename)
ws2.Range("A2:A26").Value = wb1.Sheets(1).Range("A2:A26").Value


wb1.Close savechanges:=False

Hej, det er kolonne 1 (Sags.nr.) og kolonne 5 (Kundenavn) Tror du at man kan bruge kommandoerne GotFocus eller LostFocus for at opdatere?

række til/fra ?,

ang. gotfocus/lost prøver jeg dem sidste uden jeg kunne få det til at virker, men prøver lige igen

Ups, det glemte jeg det er fra række 2 til 123, i række 1 står overskrifterne.

Du har ret gotfocus virker !!

Du skal nok ændre placering og filnavn


Private Sub ListBox1_GotFocus()
    'Filename = InputBox("Indtast filnavn:", "Filnavn", "test.xls")
    Application.ScreenUpdating = False
    Filename = "test.xls"
    Set ws2 = ActiveSheet
    Set wb1 = Workbooks.Open(Filename)
    ws2.Range("A2:A123").Value = wb1.Sheets(1).Range("A2:A123").Value
    ws2.Range("E2:E123").Value = wb1.Sheets(1).Range("E2:E123").Value
    wb1.Close savechanges:=False
    Application.ScreenUpdating = True
End Sub

lidt forbedret


Private Sub ListBox1_GotFocus()

    on error goto fejl
    'Filename = InputBox("Indtast filnavn:", "Filnavn", "test.xls")
    Application.ScreenUpdating = False
    Filename = "test.xls"
    Set ws2 = ActiveSheet
    Set wb1 = Workbooks.Open(Filename)
    ws2.Range("A2:A123").Value = wb1.Sheets(1).Range("A2:A123").Value
    ws2.Range("E2:E123").Value = wb1.Sheets(1).Range("E2:E123").Value
    wb1.Close savechanges:=False
    Application.ScreenUpdating = True
    Exit Sub
fejl:
    MsgBox ("Liste kunne ikke opdateres")
end sub

Tak :-)  nu kan jeg få datene over, jeg prøver lige at se om jeg kan få sags.nr. og kundenavn ind i en dropdownlise med "Datavalidering"

hvis du vil bruge datavalidering, kan vi opdatere dine lister hvergang filen åbenes, hvis det er fint nok?

Det lyder kanont, men tror du at det kunne lade sig gøre, at listen blev opdateret hver gang at man går han på cellen hvor dropdownlisten kommer frem?

F.eks. at hvis der er nogle kunder der starter med DO kan man så få den til at opdatere dropdownlisten så den kun viser alle de kunder der starter med DO når man har skrevet DO i den celle der har GotFocus

jooo, men så er du nød til at have skrevet DO i en anden end der hvor du har din validations liste

Ok på den måde :-)  så jeg skriver f.eks. DO i den første celle og hopper over i den anden celle med GotFocus hvor den så vil opdatere alle kunder der starter med DO... Pyyha den driller...

jeg er ved at kigge på det, bliver nok ikke færdig før i aften

Tusinde tak

Prøv dette:

hvis celle L1 bliver markeret, opdatere listen, udfra det der står til i cellen til venstre (K1), altså K1 =a ---> alpha,alfred,anders i M1:M123, hvis K1 er tom vælges alle


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim celle As String
If Not Intersect(Target, Range("L1")) Is Nothing Then
  Application.ScreenUpdating = False
   
    Filename = "test.xls"
    Set ws2 = ActiveSheet.Range("M1")
    Set wb1 = Workbooks.Open(Filename)
    num = Len(Target.Offset(0, -1).Value)
    t = 0
    For Each c In wb1.Sheets("sheet1").Range("A2:A123")
        If Target.Offset(0, -1).Value = Left(c.Value, num) Then
            ws2.Offset(t, 0) = c
            t = t + 1
        End If
    Next c
    For i = t To 123
      ws2.Offset(i, 0) = ""
    Next i
    wb1.Close savechanges:=False
    Application.ScreenUpdating = True
   
    Exit Sub
fejl:
    MsgBox ("Liste kunne ikke opdateres")
    End If
End Sub

forbehold for store og små bogstaver

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim celle As String
If Not Intersect(Target, Range("L1")) Is Nothing Then
  Application.ScreenUpdating = False
   
    Filename = "test.xls"
    Set ws2 = ActiveSheet.Range("M1")
    Set wb1 = Workbooks.Open(Filename)
    num = Len(Target.Offset(0, -1).Value)
    t = 0
    For Each c In wb1.Sheets("sheet1").Range("A2:A123")
        If UCase(Target.Offset(0, -1).Value) = UCase(Left(c.Value, num)) Then
            ws2.Offset(t, 0) = c
            t = t + 1
        End If
    Next c
    For i = t To 123
      ws2.Offset(i, 0) = ""
    Next i
    wb1.Close savechanges:=False
    Application.ScreenUpdating = True
   
    Exit Sub
fejl:
    MsgBox ("Liste kunne ikke opdateres")
    End If
End Sub

Hej,  mange tak :-) Når jeg sætter koden ind i et nyt modul og skal køre det kommer det op med et vindue hvor jeg kan lave en ny makro, ved ud hvad det kan være?

neeej, ikke helt. men,
koden skal ligge på et af arkene

Nu virker det, mange tak for hjælpen :-)
Kunne jeg få dig til at lægge et svar, så vil jeg give dig point.

Det kan du sagtens, no problemos :o)

Tak

Hej igen :-)  Jeg kom til at tænke på om man kan sortere de data som jeg får over i min dropdown-liste så de står i alfabetisk rækkefølge?