mit Makro bestimmte Zeilen übertragen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Zeile_mit_Datum() Dim wsQuelle As Worksheet Dim wsZiel As Worksheet Dim letzteQuelle As Long Dim letzteZiel As Long Dim vorhanden As Boolean Dim x As Long vorhanden = False Set wsQuelle = Sheets("Tabelle1") 'Quellblatt anpassen Set wsZiel = Sheets("Tabelle2") 'Zielblatt anpassen letzteQuelle = wsQuelle.Cells(Rows.Count, 13).End(xlUp).Row 'letzte belegte Zeile in Spalte M _ ggf. anpassen letzteZiel = wsZiel.Cells(Rows.Count, 13).End(xlUp).Row + 1 'erste freie Zeile in Spalte M ggf. _ anpassen With wsQuelle For x = letzteQuelle To 2 Step -1 'Prüfung bis Zeile 2, da angenommen in Zeile 1 Überschriften _ ggf. anpassen If IsDate(Cells(x, 13)) Then wsZiel.Cells(letzteZiel, 1).Resize(, 13).Value = .Cells(x, 1).Resize(, 13).Value 'Übertägt _ Spalte A bis Spalte M ggf. anpassen .Cells(x, 1).Resize(, 13).Delete xlUp 'löscht im Quellblatt von Spalte A bis Spalte M ggf. _ anpassen letzteZiel = letzteZiel + 1 vorhanden = True End If Next x End With If vorhanden = False Then MsgBox "Es gibt keine Datensätze mit " & vbLf & "einem Datum in Spalte M." _ & vbLf & vbLf & "Es wurden keine Daten kopiert!!", , "Hinweis für " & Environ("UserName") End If End Sub

Hallo,
besten Dank. Funktioniert bestens.
Nun soll ich aber noch drei weitere Tabellenblätter einfügen, die genau so aussehen, wie das erste. Auch aus diesen sollen nun alle Zeilen mit Eintrag in Spalte M in die "finished"-Datei rübergezogen werden. Wie muss ich das bestehende Makro anpassen? Momentan sieht das Makro wie folgt aus:

Public Sub Zeile_mit_Datum()
unprotectSheets
Dim wsQuelle As Worksheet
Dim wsZiel As Worksheet
Dim letzteQuelle As Long
Dim letzteZiel As Long
Dim vorhanden As Boolean
Dim x As Long
vorhanden = False
Set wsQuelle = Sheets("Day to Day Business open")
Set wsZiel = Sheets("finished actions")
letzteQuelle = wsQuelle.Cells(Rows.Count, 13).End(xlUp).Row
letzteZiel = wsZiel.Cells(Rows.Count, 13).End(xlUp).Row + 1
With wsQuelle
For x = letzteQuelle To 6 Step -1
If IsDate(Cells(x, 13)) Then
wsZiel.Cells(letzteZiel, 2).Resize(, 13).Value = .Cells(x, 2).Resize(, 13).Value
.Cells(x, 2).Resize(, 13).Delete xlUp
letzteZiel = letzteZiel + 1
vorhanden = True
End If
Next x
If vorhanden = False Then
MsgBox "No finished action was" & vbLf & "found in the list." _
& vbLf & vbLf & "No data transmitted!!", , "Hinweis für " & Environ("UserName")
End If
End With
protectSheets
End Sub

Public Sub unprotectSheets()
Dim Tabellenblatt As Worksheet
For Each Tabellenblatt In ThisWorkbook.Sheets
Tabellenblatt.Unprotect "bla"
Next Tabellenblatt
End Sub

Public Sub protectSheets()
Dim Tabellenblatt As Worksheet
For Each Tabellenblatt In ThisWorkbook.Sheets
Tabellenblatt.Protect "bla"
Next Tabellenblatt
End Sub

Public Sub Zeile_mit_Datum() unprotectSheets Dim wsZiel As Worksheet Dim letzteQuelle As Long Dim letzteZiel As Long Dim vorhanden As Boolean Dim x As Long Dim i AS Long vorhanden = False Set wsZiel = Sheets("finished actions") letzte Ziel = wsZiel.Cells(Rows.Count, 13).End(xlUp).Row + 1 For i = 2 To 5 'Blätter 2, 3, 4 und 5 an deine Bedürfnisse anpassen With Sheets(i) letzteQuelle = .Cells(Rows.Count, 13).End(xlUp).Row For x = letzteQuelle To 6 Step -1 If IsDate(Cells(x, 13)) Then wsZiel.Cells(letzteZiel, 2).Resize(, 13).Value = .Cells(x, 2).Resize(, 13).Value .Cells(x, 2).Resize(, 13).Delete xlUp letzteZiel = letzteZiel + 1 vorhanden = True End If Next x Next i If vorhanden = False Then MsgBox "No finished action was" & vbLf & "found in the list." _ & vbLf & vbLf & "No data transmitted!!", , "Hinweis für " & Environ("UserName") End If End With protectSheets End Sub

Hallo Patrick,
so sollte es funktionieren.
### Wichtig: Das Blatt "finished action" muss zwingend das letzte Blatt sein!!!! ###
Warum kann ich dir auch nicht sagen. Eigentlich müsste das egal sein, weil ich die Blätter über ihren Code Namen anspreche. Trotzdem funktioniert es nicht, wenn das Blatt "finished action" nicht das letzte Blatt ist.
Ich hoffe du kannst damit leben. Du solltest halt nur aufpassen wenn weitere Blätter dazu kommen.
Beispiel: Du hast insgesamt 8 Blätter. Der Code soll sich aber nur auf die Blätter 1-6 auswirken. Dann im Code die Zeile For i = 1 To 4 ändern in For i = 1 To 6. Die Blätter 7 und 8 müssen dann aber zwingend die beiden letzten Blätter sein.
https://www.herber.de/bbs/user/101986.xlsm
Gruß Werner

Beliebteste Forumthreads (12 Monate)

mit Makro bestimmte Zeilen übertragen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread