Suchen und Kopieren

Forumthread: Suchen und Kopieren

Suchen und Kopieren

23.04.2015 09:22:33

Armin

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

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchen und Kopieren

27.04.2015 11:38:58

fcs
AW: Suchen und Kopieren

28.04.2015 09:14:29

Armin

AW: Suchen und Kopieren

27.04.2015 11:38:58

fcs

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

AW: Suchen und Kopieren

28.04.2015 09:14:29

Armin

Danke, werde ich jetzt gleich mal testen.
Gruß Armin

Beliebteste Forumthreads (12 Monate)

Forumthread: Suchen und Kopieren

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread