Klappt nicht
04.05.2005 08:01:15
Slugger
Hallo,
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