ListObjects
27.11.2017 11:45:39
Gina
Hallo Zusammen,
ich bin neu im Forum weil ich ein VBA Anfänger bin.
Ich komme bei meiner Datei einfach nicht weiter siehe Beispieldatei beigefügt.
Meine codes funktionieren soweit gut nur weiß ich nicht wie ich Sie mit Listobjects, Listrow, Databodyrange umschreiben soll. Meine Versuche scheitern.
Meine codes sollen aus drei definierte Tabellen auf drei Tabellenblätter aufgeteilt: Zeilen wenn Bedingungen erfüllt sind verschieben und löschen. Funktioniert soweit gut nur das die Zeilen nicht in der definierten Tabelle landen und somit dann meine VBA Filter nicht mehr greifen können.
Hier meine codes um die es geht:
Sub clean_QRM_DoneLaterDueDate1Month() 'löscht alle Zeile deren Definition: QRM, Status: Done _
und due date: älter als 1 Monat zum Heutigem Datum
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
Dim EndDate As Long
EndDate = DateSerial(Year(Date), Month(Date), Day(Date) - 30) 'definiert Datum von Heute minus _
1 Monat
With ThisWorkbook.Worksheets("FPI QRM")
ZeileMax = .Cells(Rows.Count, 1).End(xlUp).Rows.Row
n = 0 'flex für MessageBox keinen neuen QRMs zum löschen
For Zeile = ZeileMax To 7 Step -1 'sucht nach letzter beschriebenen Zeile von unten _
damit keine übersprungen wird auch mit leerzeilen
If .Cells(Zeile, 1).Value = "QRM" Then 'sucht in spalte 1 (Definition) nach Wert _
QRM wenn ja dann
If .Cells(Zeile, 8).Value = "Done" Then 'sucht in spalte 8 (Status) nach Wert _
Done wenn ja dann
If .Cells(Zeile, 9).Value
Sub Grade_Definition() 'verschiebt alle Zeile mit Definition: action, ins Blatt actions und lö _
scht im Blatt QRM
Dim Zeile As Long
Dim ZeileMax1, Zeilemax2 As Long
Dim n As Long
With ThisWorkbook.Worksheets("FPI QRM")
ZeileMax1 = .Cells(Rows.Count, 1).End(xlUp).Rows.Row
n = 0
For Zeile = ZeileMax1 To 7 Step -1
If .Cells(Zeile, 1).Value = "action" Then
Zeilemax2 = Worksheets("FPI actions").Cells(Rows.Count, 1).End(xlUp).Rows.Row
Zeilemax2 = Zeilemax2 + 1
.Rows(Zeile).Copy Destination:=Worksheets("FPI actions").Rows(Zeilemax2)
.Rows(Zeile).EntireRow.Delete shift:=xlUp
n = 1
End If
Next Zeile
End With
If n = 0 Then
MsgBox "no new actions to moved to page FPI actions"
Else
MsgBox "all new actions sihfted to page FPI actions"
End If
End Sub
Sub Archive_Action_ClosedKilled() 'verschiebt alle Zeile mit Status closed und killed ins _
Blatt archive und löscht im Blatt actions
Dim Zeile As Long
Dim ZeileMax1, Zeilemax2 As Long
Dim n As Long
With ThisWorkbook.Worksheets("FPI actions")
ZeileMax1 = .Cells(Rows.Count, 8).End(xlUp).Rows.Row
n = 0
For Zeile = ZeileMax1 To 7 Step -1
If .Cells(Zeile, 8).Value = "Closed" Then
Zeilemax2 = Worksheets("archive").Cells(Rows.Count, 1).End(xlUp).Rows.Row
Zeilemax2 = Zeilemax2 + 1
.Rows(Zeile).Copy Destination:=ThisWorkbook.Worksheets("archive").Rows(Zeilemax2)
n = 1
.Rows(Zeile).EntireRow.Delete shift:=xlUp
End If
Next Zeile
For Zeile = ZeileMax1 To 7 Step -1
If .Cells(Zeile, 8).Value = "Killed" Then
Zeilemax2 = Worksheets("archive").Cells(Rows.Count, 1).End(xlUp).Rows.Row
Zeilemax2 = Zeilemax2 + 1
.Rows(Zeile).Copy Destination:=ThisWorkbook.Worksheets("archive").Rows(Zeilemax2)
n = 1
.Rows(Zeile).EntireRow.Delete shift:=xlUp
End If
Next Zeile
End With
If n = 0 Then
MsgBox "no new Closed actions for archive"
Else
MsgBox "all Closed/Killed actions sihfted to page archive"
End If
End Sub