Makro erweitern
09.03.2007 07:44:48
Jürgen
ich habe ein Makro aufgezeichnet und ein wichtiges Kriterium vergessen.
Das Makro soll auch noch die Spalte P ab P9 bis P30000 auch auf dem Blatt "Rohdaten"die Kundennummern absteigend sortieren.
Ich füge mal das Makro bei in der Hoffnung ihr könnt mir helfen.
Gruß
Jürgen
Sub Listen_erstellen()
' Listen_erstellen Makro
Range("A9:u30000").Select
' Application.CutCopyMode = False
Selection.Sort Key1:=Range("J9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H7").Select
Application.Run "'Listen offener Beschwerden.xls'!markieren"
ActiveWindow.ScrollRow = 676
ActiveWindow.ScrollRow = 620
ActiveWindow.ScrollRow = 564
ActiveWindow.ScrollRow = 536
ActiveWindow.ScrollRow = 508
ActiveWindow.ScrollRow = 451
ActiveWindow.ScrollRow = 423
ActiveWindow.ScrollRow = 367
ActiveWindow.ScrollRow = 339
ActiveWindow.ScrollRow = 282
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 170
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 1
Selection.AutoFilter Field:=12, Criteria1:="Rechnung"
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
Selection.AutoFilter Field:=20, Criteria1:="Im KGO-Korb"
Selection.Copy
Sheets("KGO Beschw-Re").Select
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Rohdaten").Select
Selection.AutoFilter Field:=20, Criteria1:="Im KSI-Korb"
Application.CutCopyMode = False
Selection.Copy
Sheets("KSI Beschw-Re").Select
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Rohdaten").Select
Selection.AutoFilter Field:=20
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.ScrollRow = 620
ActiveWindow.ScrollRow = 592
ActiveWindow.ScrollRow = 564
ActiveWindow.ScrollRow = 536
ActiveWindow.ScrollRow = 508
ActiveWindow.ScrollRow = 479
ActiveWindow.ScrollRow = 451
ActiveWindow.ScrollRow = 423
ActiveWindow.ScrollRow = 395
ActiveWindow.ScrollRow = 367
ActiveWindow.ScrollRow = 311
ActiveWindow.ScrollRow = 282
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 170
ActiveWindow.ScrollRow = 142
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 1
Selection.AutoFilter Field:=12
Range("A9:T20000").Select
Selection.Sort Key1:=Range("J9"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Run "'Listen offener Beschwerden.xls'!markieren"
ActiveWindow.ScrollRow = 704
ActiveWindow.ScrollRow = 676
ActiveWindow.ScrollRow = 592
ActiveWindow.ScrollRow = 508
ActiveWindow.ScrollRow = 479
ActiveWindow.ScrollRow = 423
ActiveWindow.ScrollRow = 367
ActiveWindow.ScrollRow = 339
ActiveWindow.ScrollRow = 282
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 198
ActiveWindow.ScrollRow = 142
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
Selection.AutoFilter Field:=20, Criteria1:="Im KGO-Korb"
Selection.Copy
Sheets("KGO Beschw-Auf").Select
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Rohdaten").Select
Selection.AutoFilter Field:=20, Criteria1:="Im KSI-Korb"
Selection.Copy
Sheets("KSI Beschw-Auf").Select
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Rohdaten").Select
Selection.AutoFilter Field:=20, Criteria1:="Im KSI"
Application.CutCopyMode = False
Selection.Copy
End Sub