AW: Nur Positionen Kopieren welche noch nicht vorhanden sind
25.10.2019 14:38:12
Tobias
Ja das ist mir zum Glücl schon bekannt.
Das Duplikate entfernen funktioniert jetzt durch eine modifizierung doch.
Allerdings lassen sich die gefilterten Daten nicht löschen.
Alle 3 Versionen in dem Code funktionieren nicht richtig und ich bekomme immer Laufzeitfehler.
Verstehe nicht warum das löschen von gefilterten Spalten so ein Problem darstellt.
Mein Code sieht bisher so aus:
Sub Archiv_aktualisieren()
'Display bestätigungen ausschalten
Application.DisplayAlerts = False
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Alle Daten aus PivotTabelle in "Überblick letzte 31 Tage" kopieren
Sheets("Überblick letzte 31 Tage").Select
Range("A4:I4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Einfügen in Archiv
Sheets("Archiv Ist|Soll").Select
Range("A3").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Gesamtergebnis rauslöschen
' With ActiveSheet
' .Range("A3").AutoFilter Field:=1, Criteria1:="Gesamtergebnis"
' .Rows("1:3").EntireRow.Hidden = True
' .UsedRange.SpecialCells(xlCellTypeVisible).Delete
' .Rows("1:3").EntireRow.Hidden = False
' End With
'With ActiveSheet
' .Range("A3").AutoFilter Field:=1, Criteria1:="Gesamtergebnis"
' .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
' .ShowAllData
'End With
'With Range("A3") 'Filter, offset(to exclude headers) and delete visible rows
' .AutoFilter Field:=1, Criteria1:="Gesamtergebnis"
' .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
'End With
'Filter deaktivieren
ActiveSheet.ListObjects("Tabelle4").Range.AutoFilter Field:=1
'Duplikate entfernen
'ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
Range("Tabelle4[Datum]").Select
ActiveSheet.Range("A3").RemoveDuplicates Columns:=1, Header:= _
xlYes
'Nach Datum sortieren
ActiveWorkbook.Worksheets("Archiv Ist|Soll").ListObjects("Tabelle4").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Archiv Ist|Soll").ListObjects("Tabelle4").Sort. _
SortFields.Add2 Key:=Range("Tabelle4[[#All],[Datum]]"), SortOn:= _
xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Archiv Ist|Soll").ListObjects("Tabelle4").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Auswahl aufheben
ActiveSheet.UsedRange.Cells(1, 1).Select
'Display bestätigungen ausschalten
Application.DisplayAlerts = True
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = True
ActiveSheet.UsedRange.Cells(1, 1).Select
End Sub