Autofilterfehler in VB
04.05.2005 08:14:22
Slugger
ich habe es auf einem normalen Tabellenblatt so ausprobiert. Da funtioniert es. Jedoch in meinem Code funktioniert es nicht. Hier der Code:
Private Sub CommandButton1_Click()
ActiveSheet.Unprotect ("fcn")
MsgBox "Dieser Vorgang wird ca. 40 Minuten in Anspruch nehmen. Excel kann während dieser Zeit NICHT benutzt werden", vbInformation
Sheets("Altdaten").Visible = True
Sheets("Neudaten").Visible = True
Sheets("Sicherung").Visible = True
Application.ScreenUpdating = False
Dim i As Integer
Dim k As Integer
Dim Suchwort As String
Dim Zelle As Range
Dim Gefunden As Boolean
Dim AnzahlZellenBlatt1 As Long
Dim AnzahlZellenBlatt2 As Long
'Altdaten sichern
Worksheets("Stammdaten").Range("N6:AW20000").Copy
Worksheets("Sicherung").Range("A1").PasteSpecial Paste:=xlPasteValues
Worksheets("Stammdaten").Range("AY6:AZ20000").Copy
Worksheets("Sicherung").Range("AL1").PasteSpecial Paste:=xlPasteValues
Worksheets("Stammdaten").Range("BB6:BC20000").Copy
Worksheets("Sicherung").Range("AO1").PasteSpecial Paste:=xlPasteValues
Worksheets("Stammdaten").Range("BE6:BE20000").Copy
Worksheets("Sicherung").Range("AR1").PasteSpecial Paste:=xlPasteValues
'Dateinamen auf Neuheiten überprüfen und aktualisieren
Worksheets("Altdaten").Range("A:A").Clear
Worksheets("Berechnung").Range("B:B").Copy
Worksheets("Altdaten").Range("A1").PasteSpecial Paste:=xlPasteValues
Worksheets("Neudaten").Activate
AnzahlZellenBlatt1 = Worksheets("Altdaten").UsedRange.Rows.Count
AnzahlZellenBlatt2 = Worksheets("Neudaten").UsedRange.Rows.Count
Worksheets("Altdaten").Activate
For i = 1 To AnzahlZellenBlatt1 Step 5
Suchwort = Worksheets("Altdaten").Cells(i, 1).Value
Gefunden = False
Worksheets("Neudaten").Activate
For k = 1 To AnzahlZellenBlatt2
If Suchwort = Worksheets("Neudaten").Cells(k, 1) Then
Gefunden = True
Exit For
End If
Next k
If Gefunden = False Then
Worksheets("Neudaten").Cells(AnzahlZellenBlatt2 + 5, 1).Value = Suchwort
AnzahlZellenBlatt2 = AnzahlZellenBlatt2 + 5
Worksheets("Altdaten").Select
End If
Next i
Worksheets("Neudaten").Range("A1:A20000").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
#Hier der Fehler#
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.AutoFilter Field:=1
Worksheets("Neudaten").Range("A:A").Copy
Worksheets("Stammdaten").Range("A1").PasteSpecial Paste:=xlPasteValues
Worksheets("Sicherung").Calculate
'Abgeglichene Stammdaten zurückkopieren
Worksheets("Sicherung").Range("C19998:AJ39992").Copy
Worksheets("Stammdaten").Range("P6").PasteSpecial Paste:=xlPasteValues
Worksheets("Sicherung").Range("AL19998:AM39992").Copy
Worksheets("Stammdaten").Range("AY6").PasteSpecial Paste:=xlPasteValues
Worksheets("Sicherung").Range("AO19998:AP39992").Copy
Worksheets("Stammdaten").Range("BB6").PasteSpecial Paste:=xlPasteValues
Worksheets("Sicherung").Range("AR19998:AR39992").Copy
Worksheets("Stammdaten").Range("BE6").PasteSpecial Paste:=xlPasteValues
Worksheets("Stammdaten").Range("A6:B20000").Copy
Worksheets("Stammdaten").Range("N6").PasteSpecial Paste:=xlPasteValues
Sheets("Altdaten").Visible = False
Sheets("Neudaten").Visible = False
Sheets("Sicherung").Visible = False
Application.ScreenUpdating = True
ActiveSheet.Protect ("fcn"), DrawingObjects:=False, Contents:=True, Scenarios:= _
True
End Sub
also im ersten Teil kopiert er nur die alten Daten ins Sicherung Tabellenblatt.
im zweiten Teil vergleicht er praktisch nur eine Spalte von Altdaten mit der Spalte aus Neudaten und schreibt neu hinzugekommene unten an letzter Stelle.
Nun sollte er den Vorschlag ausführen mit Autofilter usw. (Im anderen Post vorgeschlagen).Hier bringt er jedoch einen Fehler.
Im letzten Teil wird erst das Sicherungsblatt berechnet das mit Sverweisen verkknüpft ist und danach werden die aktualisierten Daten wieder ins Stammdatenblatt kopiert.
Alles funktioniert, bis auf das mit dem Autofilter. Warum jedoch hab ich keine Ahnung.
Gruß
Slugger