mit Makro bestimmte Zeilen übertragen

Patrick · 2015-11-27T11:28:10+00:00

Hallo, ich stehe vor folgender Aufgabe: Mit einem Makro soll das erste Tabellenblatt nach Datumseinträgen in der Spalte M abgesucht werden. Das Datum wird in Form von TT.MM.JJJJ eingetragen. Die gefundenen Zeilen sollen dann ausgeschnitten werden und in das Tabellenblatt 2 fortlaufend eingefügt werden. Vorraussetzungen: 1. Nur die Werte sollen übertragen werden, keine Formeln. 2. Spalte A ist in beiden Tabellen mit fortlaufenden Nummern gefüllt. Diese sollen unbeachtet bleiben. 3. Die "freien" Zeilen im Tabellenblatt 1 sollen dann verschwinden, die Tabelle sich also zusammenziehen, dass keine freien Zeilen zu sehen sind. Kann mich hier jemand unterstützen? MfG

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

Hallo Patrick,
hab mal was gebastelt, ist aber nicht getestet, hab es nur kurz am Tablet geklimpert (hab ehrlich gesagt keinen Bock mehr jetzt noch meine Kiste anzuwerfen). Kann also nicht garantieren, dass es funktioniert.

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

Über die Variable i spreche ich die Blätter über ihren INDEX an. Das hat weder was mit dem zu tun, was auf dem Tabellenblattreiter steht. Wenn du im VBA-Projektexplorer oben links Schausteller dann stehen da u.a. die Tabellenplätze die es im Workbook gibt. Da steht dann z.B. Tabelle1 (Tabelle1) oder aber auch
Tabelle1 (DeinTabellenblattnamen) wenn du die Tabelle umbenannt hast. Das was vor der Klammer steht ist der interne Indexname des Tabellenblattes.
Derzeit sollten (wenn es denn funktioniert) die Daten aus den Blättern 2-3-4-5 gezogen werden. Blatt 1 und ggf. weitere Blätter bleiben außen vor.
Das müsstest du hält an deine Bedürfnisse anpassen. For i = 2 To 5 (Blatt 2,3,4,5)
For i = 3 To 4 (Blatt 3,4)
Gruß Werner

mit Makro bestimmte Zeilen übertragen

Forumthread: mit Makro bestimmte Zeilen übertragen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

mit Makro bestimmte Zeilen übertragen

Forumthread: mit Makro bestimmte Zeilen übertragen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread