Durchsuchen einer Datei und neue Werte holen
21.03.2017 16:07:50
Björn
ich habe einen Code zusammengestupft um von einer Datei neue Werte in eine Arbeitsdatei zu holen.
Das funktioniert auch, wenn in der Quelldatei die erste Spalte das neue eineindeutige Kriterium ist.
Leider ist in der Quelldatei´, hier als Master.xlsm bezeichnet, das zu suchende Kriterium in der 3. Spalte.
Ich kenne mich im VBA Code nicht aus. Daher weiß ich nicht, welcher Code die Suche in einer speziellen Spalte ausführt.
Kann mir dazu jemand helfen?
Vielen herzlichen Dank.
Björn
hier der Code:
Sub Aktualisieren()
Dim wkb As Workbook
Dim wkb1 As Workbook
Dim wks As Worksheet
Dim wks1 As Worksheet
Dim rng As Range
Dim iRow As Integer
Dim i
Application.ScreenUpdating = False
On Error Resume Next
On Error GoTo 0
l = 1
For Each w In Workbooks
If w.Name = "Master.xlsm" Then
l = 0
Exit For
End If
Next w
If wkb Is Nothing And l = 1 Then
If Dir(ThisWorkbook.Path & "\Master.xlsm") = "" Then
Beep
MsgBox "Quelldatei wurde nicht gefunden!"
Exit Sub
Else
Workbooks.Open ThisWorkbook.Path & "\Master.xlsm"
End If
End If
Set wkb = ThisWorkbook
Set wkb1 = Workbooks("Master.xlsm")
wkb1.Activate
Set wks = wkb.Worksheets("Tabelle1")
Set wks1 = wkb1.Worksheets("Tabelle1")
anz = wks.Cells(65536, 1).End(xlUp).Row
anz1 = wks1.Cells(65536, 1).End(xlUp).Row
For z = 2 To anz1
suchwert = wks1.Cells(z, 1)
With wks.Range("a2:a" & anz)
Set c = .Find(suchwert, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
For s = 2 To 11
wks.Cells(c.Row, s) = wks1.Cells(z, s)
Next
Else
For s = 1 To 11
wks.Cells(anz + 1, s) = wks1.Cells(z, s)
Next
anz = wks.Cells(65536, 1).End(xlUp).Row
End If
End With
Next
Application.ScreenUpdating = True
End Sub