Suchen und Kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Suchen und Kopieren
von: Armin
Geschrieben am: 23.04.2015 09:22:33

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

Bild

Betrifft: AW: Suchen und Kopieren
von: fcs
Geschrieben am: 27.04.2015 11:38:58
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


Bild

Betrifft: AW: Suchen und Kopieren
von: Armin
Geschrieben am: 28.04.2015 09:14:29
Danke, werde ich jetzt gleich mal testen.
Gruß Armin

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Suchen und Kopieren"