Da mir hier ziemlich gut geholfen wurde, wende ich mich gerne nochmal an die Profis hier :D
Und zwar geht es dieses mal um folgendes:
Ich habe eine Datei mit mehreren Blättern (Tabelle1, 45.01, 45.02,usw.).
In der Tabelle1 werden jeweils Daten aufgenommen bzw. festgehalten, den Code hierfür habe ich und der funktioniert soweit bestens.
Nun aber mein eigentliches Problem: In den Blättern 45.01, 45.02, usw. habe ich ab Zeile 49 eine zusätzliche Liste. Ziel ist es, dass ich über einen VBA - Befehl, welcher an einen Button "verknüpft" ist, im ersten Blatt (Tabelle1) in den Spalten E bis H nach dem Wert (45.01,45.02, usw.) suchen kann und mir dann die ganze Zeile wo der Wert enthalten ist in das entsprechende Blatt kopiert wird.
Wenn ich beim Blatt 45.01 auf den Button "Daten kopieren" drücke, dann sollen alle Zeilen in den der Wert "45.01" vorkommt ins Blatt 45.01 in der nächsten leeren Zeile eingefügt werden. Das Gleiche für die Blätter 45.02, 45.03, usw.
Wenn das möglich ist, wäre es super. Perfekt wäre es natürlich, wenn nur neue Werte kopiert werden und die alten bestehen bleiben. Wenn aber jedes mal beim Drücken auf "Daten kopieren" sämtliche Zeilen kopiert werden in denen der gesuchte Wert vorkommt, ist das nicht schlimm.
Bisher habe ich nur folgendes gefunden, aber irgendwie kriege ich den Code nicht so hin wie ich ihn gerne hätte;
Public Sub CopyRows()
Sheets("Tabelle1").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 = "45.01" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("45.01").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("45.01").Select
ElseIf ThisValue = "45.02" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("45.02").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next x
End Sub
https://www.herber.de/bbs/user/152673.xlsm
Ich danke euch im Voraus ganz herzlich :)