Suchen und Kopieren

Hallo zusammen,
ich versuche vergeblich mir ein Makro zu basteln. Leider komme ich nicht weiter.
Folgender Aufbau.
Es gibt 2 Dateien, die Erste "Quelle" in der befinden sich von Spalte A bis Spalte I Informationen. in Spalte U ein "Suchbegriff".
Dann die 2te Datei "Ziel" hier soll das Kopierte eingesetzt werden.
Das Makro soll jetzt in der "Quelle" in Spalte U1 bis U800 den "Suchbegriff" suchen.
Wenn dieser Gefunden wurde (z.B. in U20), dann soll das Makro ab der Zeile in der der Suchbegriff steht Spalte A(Zeile ab Suchbegriff) bis Spalte I(Zeile Suchbegriff +100 ) in die Datei "Ziel" kopieren.
In der Datei "Ziel" soll das kopierte dann ab A4 eingefügt werden.
Der Suchbegriff steht immer Fest.
Hoffe Mir kann jemand helfen und meine Erklärung war nicht zu kompliziert.
Grüße
OnkelMatt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo OnkelMatt,
wenn beide Dateien geöffnet sind, dann kann man das folgende Makro anwenden. Beim Start des Makros muss die Zielmappe die aktive Datei sein.
Wenn die Quellmappe geschlossen ist, dann muss eine passen Öffnen-Anweisung eingebaut werden, wobei die Datei dann schreibgeschützt geöffnet werden sollte.
Gruß
Franz

Sub Suchen_Kopieren()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim varSuchbegriff, rngSuche As Range, ZeileSuche As Long
varSuchbegriff = VBA.InputBox("Suchbegriff", "gesuchte Daten nach Zieltabelle kopieren")
If varSuchbegriff = "" Then Exit Sub
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Tabelle1")          'Blattname ggf. anpassen
Set wkbQuelle = Application.Workbooks("Quelle.xlsx")  'Dateiname ggf. anpassen
Set wksQuelle = wkbQuelle.Worksheets("TabQuelle")     'Blattname ggf. anpassen
With wksQuelle
Set rngSuche = .Range("U:U").Find(what:=varSuchbegriff, after:=.Range("U10000"), _
LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If rngSuche Is Nothing Then
Else
ZeileSuche = rngSuche.Row
.Range(.Cells(ZeileSuche, 1), .Cells(ZeileSuche + 100, 9)).Copy
wksZiel.Range("A4").Insert shift:=xlShiftDown
Application.CutCopyMode = False
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suchen und Kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread