Werte in anderer Datei suchen und kopieren

Hallo!
Ich habe folgendes Problem:
Es gibt 2 Excel-Dateien mit gleichen Spaltenaufbau.
In der 1. Datei sind in Tabelle1, SpalteA(dynamische Länge), ab Zelle A4 die zu suchenden Werte.
Diese Werte sollen in der 2. Datei auch in Tabelle1, SpalteA(dynamische Länge), ab Zelle A4 nach und nach gesucht werden.
Wird der entsprechende Zellwert in Spalte A der 1.Datei gefunden, so soll der Wert aus der gleichen Zeile aber aus Spalte E in die dem Suchbegriff entsprechende Zelle Spalte E in der 1. Datei kopiert werden.
Wird eine Wert nicht gefunden, so soll die Suche mit dem nächsten Wert fortsetzt werden.
Ich hoffe es ist nicht zu kompliziert beschrieben.
Wäre dankbar für ein paar Tipps dazu.
Gruß Pierre

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Suche() Dim rSuche As Range, rFinde As Range Dim lngLetzte1 As Long, lngLetzte2 As Long Dim wkb1 As Workbook, wkb2 As Workbook Dim wks1 As Worksheet, wks2 As Worksheet Dim iLauf As Integer Set wkb1 = ThisWorkbook Set wkb2 = Workbooks("Name des anderen Workbooks")' hier Namen anpassen Set wks1 = wkb1.Sheets("Tabelle1") Set wks2 = wkb2.Sheets("Tabelle1") With wks1 lngLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows. _ Count) End With With wks2 lngLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows. _ Count) End With Set rFinde = wks2.Range("A4:A" & lngLetzte2) With wks1 For iLauf = 4 To lngLetzte1 Set rSuche = rFinde.Find(what:=.Cells(iLauf, 1), LookAt:=xlWhole, LookIn:=xlValues) If Not rSuche Is Nothing Then rSuche.Offset(0, 4).Copy .Cells(iLauf, 5) End If Next iLauf End With End Sub

Hallo Pierre,
meine Lösung.
Code muss im VBA-Editor unter dem Tabellenblatt eingefügt werden in dem in Spalte A die Suchbegriffe eingegeben werden.
Gruß
Franz


Private wbQuelle As Workbook, wbZiel As Workbook
Private wksQuelle As Worksheet, wksZiel As Worksheet
Private Const strQuelle As String = "MappeQuelle.xls" 'Datei mit den zu suchenden Werten
Private Const strPfadQuelle As String = "C:\Lokale Daten\Test"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
'Eingaben in Spalte A überwachen
If Target.Column = 1 And Target.Row >= 4 Then
Set wbZiel = ThisWorkbook
Set wksZiel = wbZiel.Worksheets(1)
'prüfen, ob Quell-Datei geöffnet
For Each wbQuelle In Application.Workbooks
If LCase(wbQuelle.Name) = LCase(strQuelle) Then Exit For
Next
If wbQuelle Is Nothing Then
'Quelldatei öffnen
Application.ScreenUpdating = False
Set wbQuelle = Workbooks.Open(Filename:=strPfadQuelle & "\" & strQuelle)
wbZiel.Activate
Application.ScreenUpdating = True
End If
Set wksQuelle = wbQuelle.Worksheets(1)
For Each Zelle In Target.Range("A1:A" & Target.Rows.Count)
Call WertSuchen(varSuchen:=Zelle.Value, ZeileZ:=Zelle.Row, ErsteSuchzeile:=4, _
Zielspalte:=5, Suchspalte:=1, OffsetSuchSpalte:=4)
Next
Set wbQuelle = Nothing: Set Zelle = Nothing: Set wbZiel = Nothing
Set wksQuelle = Nothing: Set wksZiel = Nothing
End If
End Sub
Sub WertSuchen(varSuchen As Variant, ZeileZ As Long, ErsteSuchzeile As Long, _
Zielspalte As Integer, Suchspalte As Integer, OffsetSuchSpalte As Integer)
Dim Zelle As Range
Application.EnableEvents = False
Set Zelle = wksQuelle.Columns(Suchspalte).Find(What:=varSuchen, LookIn:=xlValues, lookat:= _
xlWhole)
If Zelle Is Nothing Then
wksZiel.Cells(ZeileZ, Zielspalte).Value = "nicht gefunden"
Else
If VBA.IsEmpty(varSuchen) = True Then
wksZiel.Cells(ZeileZ, Zielspalte).ClearContents
Else
If Zelle.Row >= ErsteSuchzeile Then
wksZiel.Cells(ZeileZ, Zielspalte).Value = Zelle.Offset(0, OffsetSuchSpalte).Value
Else
wksZiel.Cells(ZeileZ, Zielspalte).Value = "nicht gefunden"
End If
End If
End If
Set Zelle = Nothing
Application.EnableEvents = True
End Sub

Beliebteste Forumthreads (12 Monate)

Werte in anderer Datei suchen und kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte in anderer Datei suchen und kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread