AW: Sortierung per VBA
30.10.2003 14:18:31
Sven
Hier haste mal den ganzen Code der für deine Fragen wichtig ist.
Und ja ich hab mit F8 gearbeitet und wie schon gesagt,wenn er an die Sortierung kommt, bekomme ich laufzeitfehler 1004!Er Selected auch den Datenbereich im neuen Workbook, aber bei sorten bekomm ich den fehler.
Private Sub CommandButton1_Click()
Worksheets("Berechnungen").Unprotect Password = "abc"
Dim sPath, sWks, sFile As String
Dim b, i
Dim zellinhalt
Application.ScreenUpdating = False
ActiveSheet.Range("a11:z1000").Select
sPath = ActiveWorkbook.Path & "\"
sWks = "Berechnungen"
sFile = [F2].Value & " - " & [I2].Value & ".xls"
ActiveSheet.Copy
ActiveSheet.Name = sWks
ActiveSheet.Shapes("CommandButton1").Delete
ActiveSheet.Shapes("CommandButton2").Delete
ActiveWorkbook.SaveAs Filename:=sPath & sFile
ActiveSheet.Range("a11:z1000").Select
Selection.ClearContents
i = 11
For b = 11 To 1000
zellinhalt = ThisWorkbook.ActiveSheet.Range("G" & b).Value
Select Case zellinhalt
Case "n", "v", "a", "s"
i = i + 1
ThisWorkbook.ActiveSheet.Rows(b & ":" & b).EntireRow.Copy
Workbooks(sFile).Sheets(sWks).Range("A" & i).Select
ActiveSheet.Paste
If Workbooks(sFile).Sheets(sWks).Range("b" & i) <> "" Then
Workbooks(sFile).Sheets(sWks).Range("h" & i) = "=R" & i & "C9/R" & i & "C3"
Else
Workbooks(sFile).Sheets(sWks).Range("i" & i) = "=R" & i & "C8*R" & i & "C3"
End If
Case ""
GoTo Label1
End Select
Label1:
Next b
Windows(sFile).Activate
Worksheets("Berechnungen").Range("a12:x" & i).Select
Selection.Sort Key1:=Range("s12"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For c = 11 To 500
If Workbooks(sFile).Sheets(sWks).Range("b" & c) <> "" Then
Workbooks(sFile).Sheets(sWks).Range("h" & c) = "=R" & c & "C9/R" & c & "C3"
Else
Workbooks(sFile).Sheets(sWks).Range("i" & c) = "=R" & c & "C8*R" & c & "C3"
End If
Next
ActiveSheet.Range("a10").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Worksheets("Berechnungen").Protect Password = "abc"
End Sub