trotz Autofilter neue Zeile einfügen

Hallo Foren-Gemeinde,
nachdem ich nun doch schon einige Zeit hier stöbere und meistens eine Lösung finde muss ich euch heute doch direkt bemühen.
Folgendes Problem treibt mich seit Tagen zum Wahnsinn:
Ich habe eine Planungsliste, welche sowohl Daten zu Versuchsträgern als auch die Wochenplanung für den Versuch enthält.
Nun ist diese Liste mit einem Autofilter belegt, welcher ermöglicht z.B. nach Prüfstand o.ä. zu sortieren.
Nun habe ich eine "Master"_Zeile geschaffen in welche neue Versuchsträger eingetragen werden und mit Hilfe eines Buttons in die aktuelle Prüfstandplanung integriert werden. (Einfach 3 Zeilen weiter unten in die Liste eingefügt"
Das läuft mit Pastespecial ab, da auch die Formatierung übernommen werden soll.
Das funktioniert auch hervorragend, bis zu dem Zeitpunkt, wenn ein Autofilter aktiv ist und zum Beispiel nur noch Prüfstand 4 angezeigt wird, kommt eine Fehlermeldung und der Code wird bei .PasteSpecial abgebrochen
hier der Code:
Rows("11:13").Copy hier wird der neue Versuchsträger eingetragen
Rows("15:17").Insert Shift:=xlDown bisher aktueller Eintrag, jetzt neue Zeile und Ziel
Rows("15:17").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Rows("15:17").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Fehler bei gesetztem Filter ist:
PasteSpecial-Methode kann bei dem Range-Objekt nicht angewendet werden
Ich hoffe es kann mir jemand von euch erklären, wie ich trotz gesetzem Filter eine neue Zeile einfügen kann und diese dann auch befüllen kann.
Nach dem füllen, sollte die Zeile, falls nicht vom Filter getroffen, natürlich auch verschwinden!
Vielen Dank im Voraus und viele Grüße
Jens

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo jens,
das Problem kann man nur umgehen, indem man die gesetzten Filter in Variablen merkt, alle Daten anzeigt, die Daten kopiert und dann den Filter wieder setzt.
Ich hab jetzt nicht alle Autofiltervarianten bei den Criterien getestet, aber die wesentlichen sollten funktionieren.
Gruß
Franz

Sub DatenSatzEinfügen()
Dim wks As Worksheet, oFilter As Filter
Dim arrCriteria1() As String, arrOperator() As Long, arrCriteria2() As String
Dim arrON() As Boolean, bolFilter As Boolean
Dim iIndex As Long
On Error GoTo Fehler
Set wks = ActiveSheet
With wks
'Check ob Autofilter aktiv
If wks.AutoFilterMode = True Then
'Check ob Filter gesetzt
For Each oFilter In .AutoFilter.Filters
If oFilter.On = True Then
bolFilter = True
Exit For
End If
Next
If bolFilter = True Then
'Filtereinstellungen merken
ReDim arrCriteria1(1 To .AutoFilter.Filters.Count)
ReDim arrCriteria2(1 To .AutoFilter.Filters.Count)
ReDim arrOperator(1 To .AutoFilter.Filters.Count)
ReDim arrON(1 To .AutoFilter.Filters.Count)
For iIndex = 1 To .AutoFilter.Filters.Count
arrON(iIndex) = .AutoFilter.Filters(iIndex).On
If .AutoFilter.Filters(iIndex).On = True Then
arrCriteria1(iIndex) = .AutoFilter.Filters(iIndex).Criteria1
arrOperator(iIndex) = .AutoFilter.Filters(iIndex).Operator
arrCriteria2(iIndex) = .AutoFilter.Filters(iIndex).Criteria2
End If
Next
wks.ShowAllData
End If
End If
'Daten kopieren
.Rows("11:13").Copy 'hier wird der neue Versuchsträger eingetragen
.Rows("15:17").Insert Shift:=xlDown 'bisher aktueller Eintrag, jetzt neue Zeile und Ziel
.Rows("15:17").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Rows("15:17").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Filter wieder setzen
If bolFilter = True Then
For iIndex = 1 To .AutoFilter.Filters.Count
If arrON(iIndex) = True Then
If arrCriteria2(iIndex) = "" Then
.AutoFilter.Range.AutoFilter Field:=iIndex, Criteria1:=arrCriteria1(iIndex)
ElseIf arrOperator(iIndex)  0 Then
.AutoFilter.Range.AutoFilter Field:=iIndex, _
Criteria1:=arrCriteria1(iIndex), _
Operator:=arrOperator(iIndex), _
Criteria2:=arrCriteria2(iIndex)
End If
End If
Next
End If
End With
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 1004 'Tritt auf, wenn nicht vorhandenes Criterium in Variable gelesen werden soll
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbNewLine & .Description
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

trotz Autofilter neue Zeile einfügen

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

trotz Autofilter neue Zeile einfügen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread