Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 08:39:33
Fehler bei: BlattBereich als .jpg in andere .xlsm kopieren
16.05.2024 23:36:08
IFNA Funktion in WENNNV übertragen
16.05.2024 19:31:55
Zellenfarbe beim.Filtern ändern
16.05.2024 19:29:08
Mit INDIREKT() auf andere Tabellenblätter referenzieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1960to1964
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1960to1964
1960to1964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabellen durchsuchen und in mehrere Tabellen kopieren

Tabellen durchsuchen und in mehrere Tabellen kopieren
31.01.2024 15:08:20
Joe T.
Hi,
ich habe eine Tabelle mit ca. 5000 Zeilen an Rohdaten.
Ich möchte in (Rohdaten) Spalte A ab Zeile 2 nach einem Wert (veränderbarer Text und Zahlenwert aus der Zieltabelle(Zelle A:1) {z.B. "ABC01" aus "xxxxABc01xxx"} ) suchen.
Wenn dieser gefunden wird, soll die Zeile in die Tabelle mit dem Suchwert aus (Zieltabelle2,3,4...) in die selbige ab Zeile 2 kopiert werde.
Die Ergebnisse in den Tabellen sollen untereinander angeordnet werden.

Mit Makroaufzeichnen komme ich hier leider an meine Grenzen weil es bis zu 30+ Tabellen werden.

Vorab Danke an die Profis!!

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellen durchsuchen und in mehrere Tabellen kopieren
31.01.2024 15:15:10
SF
Hola,
eine Beispieldatei wäre hilfreich.
Gruß,
steve1da
AW: Tabellen durchsuchen und in mehrere Tabellen kopieren
31.01.2024 16:29:37
Piet
Hallo

der Suchwert steht doch in der Formel von steve1da in Zelle B1. Da musst du doch nur den Wert ändern!

mfg Piet
AW: Tabellen durchsuchen und in mehrere Tabellen kopieren
31.01.2024 15:37:18
SF 
=FILTER(ROH!A1:E10;RECHTS(ROH!A1:A10;4)=B1)
AW: verschiedene Lösungsvarianten möglich ...
31.01.2024 15:37:21
neopa C
Hallo Joe,

... neben einer VBA-Lösung (mit VBA beschäftige ich mich nicht) wäre einer Formellösung möglich. Dies in Deiner Version mit Hilfe der Funktion FILTER().
Oder eben auch mit Power Query (PQ) Funktionalität (mehr zu Power Query (PQ) sieh z.B. mal hier: https://excelhero.de/power-query/power-query-ganz-einfach-erklaert/) und da einfach über dessen Filterfunktionaltät.

Gruß Werner
.. , - ...
Anzeige
AW: verschiedene Lösungsvarianten möglich ...
31.01.2024 15:44:19
Joe T.
Danke für den Tip,

nur Filtern aus den Zellen klappt so nicht. Es soll bei neuen Rohdaten in den Tabellen auch der Suchwert angepasst werden!
Dann Makro mit Funktionsfeld starten und alles neu!

Gruß Joe
AW: und wie soll der Suchwert dann angepasst werden? owT
31.01.2024 15:50:36
neopa C
Gruß Werner
.. , - ...
AW: verschiedene Lösungsvarianten möglich ...
31.01.2024 18:01:58
Joe T.
Ich habe das erst mal wie folgt gelöst.....(nicht das beste, aber funzt)

Public Sub CopyRows()
Sheets("ROH").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
ThisValue = Cells(x, 1).Value
If ThisValue Like "*AA*" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("AA").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("ROH").Select
ElseIf ThisValue Like "*BB*" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("BB").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("ROH").Select
End If
Next x
End Sub
Anzeige
AW: verschiedene Lösungsvarianten möglich ...
31.01.2024 19:34:13
Piet
Hallo

Glückwunsch wenn du eine eigene Lösung gefunden hast die funktioniert. Auch wenn es eine Recorder Lösung ist.
Man kann den Code verbessern, indem man auf Select verzichtet. Dann sähe der Code so aus. Ungetestet.

mfg Piet 

Public Sub CopyRows()

Dim AA As Worksheet, FinalRow

Dim BB As Worksheet, NextRow

Set AA = Sheets("AA")

Set BB = Sheets("BB")



With Sheets("ROH")

    ' Find the last row of data

    FinalRow = .Cells(Rows.Count, 1).End(xlUp).ROW

    ' Loop through each row

    For x = 2 To FinalRow

        ' Decide if to copy based on column D

        ThisValue = .Cells(x, 1).Value

        If ThisValue Like "*AA*" Then

           Cells(x, 1).Resize(1, 33).Copy

           NextRow = AA.Cells(Rows.Count, 1).End(xlUp).ROW + 1

           AA.Cells(NextRow, 1).PasteSpecial xlPasteAll

        ElseIf ThisValue Like "*BB*" Then

           Cells(x, 1).Resize(1, 33).Copy

           NextRow = BB.Cells(Rows.Count, 1).End(xlUp).ROW + 1

           BB.Cells(NextRow, 1).PasteSpecial xlPasteAll

        End If

    Next x

    Application.CutCopyMode = False

End With

End Sub
Anzeige

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige