Hi,
ich hab’s nochmal umgeschrieben (aber wieder nicht testen können, falls es nicht läuft, melde dich …).
Da wo steht " Hier werden die Startwerte gesetzt " kannst du konfigurierend eingreifen. Ich habe die Startwerte mit Kommentaren versehen, die das hoffentlich erklären.
=============================
Option Explicit
Sub Update()
’
Dim a, WorkbookSenke, WorkbookQuelle, DateiPfad, DateiName As Variant
Dim PosBackSlash, i, j, D1StartZeile, D1StartSpalte, D2StartZeile, D2StartSpalte, D2D1Zeile, D2D1Spalte As Integer
’ Aktuelles Workbook feststellen
WorkbookSenke = ActiveWorkbook.Name
’ Hier werden die Startwerte gesetzt
’ allgemein gilt bei den Splatenwerten 1=A, 2=B, 3=C etc
’ Datei1
D1StartZeile = 1 'Zeile, in der in D1 die Suche beginnt
D1SuchSpalte = 1 'Spalte, in der in D1 gesucht wird
D1DatenSpalte = 1 'Spalte, aus der in D1 die Daten kopiert werden
’ Datei2
D2StartZeile = 2 'Zeile, bei der die Verarbeitung in Datei 2 beginnt
D2SuchwertSpalte = 1 'Spalte, in der in D2 der zu suchende Wert steht
D2DatenSpalte = 1 'Spalte, in der in D2 die aus D1 kopierten Daten eingetragen werden sollen
’ Wo ist in Datie 2 der Pfad von Datei 1 konfiguriert
D2D1Zeile = 1
D2D1Spalte = 1
’ Ermittle DateiPfad und DateiName
DateiPfad = Cells(D2D1Zeile , D2D1Spalte)
PosBackSlash = InStr(1, DateiPfad, „“, 1)
DateiName = Mid(DateiPfad, PosBackSlash + 1)
’ Öffne Datei
On Error Resume Next
Workbooks.Open Filename:=DateiPfad
If Err.Number 0 Then
’ Fehlermeldung
a = MsgBox(DateiPfad & " existiert nicht", vbOKOnly, „Abbruch der Verarbeitung“)
Exit Sub
Else
On Error GoTo 0
WorkbookQuelle = ActiveWorkbook.Name
End If
Workbooks(WorkbookSenke).Activate
i = D2StartZeile
While Cells(i, 1) „“
j = D1StartZeile
While Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) „“ _
And Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) Cells(i, D2SuchwertSpalte)
j = j + 1
Wend
If Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1SuchSpalte) = Cells(i, D2SuchwertSpalte) Then
Cells(i, D2DatenSpalte) = Workbooks(WorkbookQuelle).Sheets(„Quelle“).Cells(j, D1DatenSpalte)
Else
Cells(i, D2DatenSpalte) = „“
End If
i = i + 1
Wend
'QuellDatei schließen
Workbooks(WorkbookQuelle).Close SaveChanges:=False
End Sub
Gruß
Volker