Office: (Office 365) VBD Daten aus einer "intelligenten" Tabelle in einer anderen "intelligenten" Tabelle archivieren

Hallo zusammen,

Ich hab hier schon viel rumgeschaut, komme aber mit meinem Problem leider nicht weiter.
Vielleicht könnt ihr mir ja weiterhelfen.

Ich habe eine Tabelle ("tbl_Umsatz"), auf dem Worksheet "Umsatz", bei der ich alle Datensetze (Zeilen) die in der Spalte "Status" (Spalte F) als "Abgerechnet" gekennzeichnet werden, automatisch auf ein anderes Worksheet ("Abgerechnet") in eine zweite Tabelle (tbl_Umsatz_abgerechnet) verschoben werden sollen.

Dabei sollen die Daten da gesammelt werden und nicht überschrieben werden.
Wenn möglich sollen sie sich auch an das Format in der zweiten Tabelle anpassen (Schriftgröße und Farbe).

Bisher habe ich folgendes:

Sub Makro1()

'Tabelle einlesen

Dim rng As Range
Dim wb_Abgerechnet As Worksheet

'Tabelle in Range einlesen

Set rng = tb_Umsatz.ListObjects("tbl_Umsatz").Range

'Autofilter setzen
rng.AutoFilter 5, "Abgerechnet"

'Set wb_Abgerechnet = Worksheet.tb_Abgerechnet

'Gefilterte Tabelle in die neue Tabelle kopieren
If Rows.Hidden = False Then
rng.SpecialCells(xlCellTypeVisible).Copy tb_Abgerechnet.ListObjects("Umsatz_abgerechnet")

End If
End Sub

Da absoluter Änfanger bin hoffe ich auf eure Hilfe.

Beste Grüße
Uwe

 

Hallo,

Code:

Sub hsv()
  With Sheets("Umsatz").ListObjects("tbl_Umsatz").DataBodyRange
     .AutoFilter 5, "Abgerechnet"
     .Copy Sheets("Abgerechnet").ListObjects("Umsatz_abgerechnet").ListRows.Add.Range
     .AutoFilter
  End With
End Sub

 

Hallo HSV,

vielen Dank für die schnelle Reaktion!
Eine Frage hätte ich da aber noch. Die Daten werden jetzt kopiert, kann man sie auch verschieben so das sie aus der ersten Tabelle verschwinden ?

 

Auch das,

Code:

Sub hsv()
Application.DisplayAlerts = False
  With Sheets("Umsatz").ListObjects("tbl_Umsatz").DataBodyRange
     .AutoFilter 5, "abgerechnet"
     .Copy Sheets("Abgerechnet").ListObjects("Umsatz_abgerechnet").ListRows.Add.Range
     .Delete
     .AutoFilter
  End With
End Sub

 

Super, vielen Dank für die schnelle Hilfe

 

Leider ist heute beim ausgiebigen Testen aufgefallen, dass wenn man das Makro startet, ohne das eine Zelle mit "Abgerechnet" markiert ist, die ganze Tabelle gelöscht wird ...

 

Damit sollte es besser werden.

Code:

Sub hsv()
Application.DisplayAlerts = False
  With Sheets("Umsatz").ListObjects("tbl_Umsatz").DataBodyRange
      .AutoFilter 5, "abgerechnet"
     If Application.Subtotal(3, .Columns(5)) > 0 Then
      .Copy Sheets("Abgerechnet").ListObjects("Umsatz_abgerechnet").ListRows.Add.Range
      .Delete
     End If
     .AutoFilter
  End With
End Sub