Hallo community,
habe folgendes Problem zu dem ich weder eine Lösung selbst noch im Internet finden konnte:
In einer Tabelle werden händisch aktuelle Obligen zu Kundengruppen eingetragen. Via VBA werden dann in dieser Tabelle bestimmte farblich hinterlegte Zellen einer gewissen Spalte ermittelt und die komplette Zeile dann in eine andere Tabelle namens 'Mirror' übertragen. Von den übertragenen Spalten sollen dann einige gelöscht werden, um die restlichen via PivotTable in einer weiteren Tabelle auszuwerten.
Der Code hat jetzt bestimmt 4 Monate gut funktioniert. Seit Montag spinnt der Code jedoch und unterbricht mit dem Laufzeitfehler 1004 und dem Hinweis, dass die Datenquelle des PivotTable nicht geändert werden darf.
Hier Auszüge aus dem Code unter Excel 2016:
'Eigentlicher Code:
Dim q As Long ' Zeilen# Quell-Tabelle
Dim z As Long ' Zeilen# Ziel-Tabelle
Const iFarbe As Long = 15 ' Zellfarbe Sp G
Dim wsZ As Worksheet ' Ziel-Tabelle
Dim LRow As Long ' letzte Zeile in Quell-Tabelle
' Initialisieren
Set wsZ = Worksheets("Mirror")
z = 1
' Zeilen mit best. Farbwert in Spalte G der 'KNE'-Liste nach 'Mirror' kopieren
With Worksheets("KNE")
LRow = .Cells(Rows.Count, "A")
For q = 1 To 500
If .Cells(q, "G").Interior.ColorIndex = iFarbe Then
z = z + 1
.Rows(q).Copy
wsZ.Range("A" & z).PasteSpecial xlPasteValues
End If
Next q
End With
' Daten in Mirror sortieren nach Spalte G
With wsZ
.Range("A2:G" & z).Sort Key1:=.Range("G1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.CutCopyMode = False
End With
' Unnütze Spalten löschen
Dim Bereich As Range
Set Bereich = Union(Range("A2:B50"), Range("D2:F50"))
Bereich.Delete
Und bei Bereich.Delete unterbricht er dann.
Die Datei kann ich zur Unterstützung leider nicht zur Vefügung stellen. Aber vlt. kennt jemand einen geschickten Kniff aus dem Stehgreif.
Vorab schon einmal besten Dank für jede Hilfe!
Beste Grüße
Felix