VBA code om te sorteren, kan deze simpeler en kleiner?

[Youri92]

ik heb de volgende macro om een bepaald bereik te sorteren in meerdere sheets, omdat het om 135 sheets gaat zou ik willen kijken of de code sneller kan of simpeler. iemand ideeen?

dit is mn code (ik heb de code al opgedeeld in meerdere subs zodat hij 10 paginas per keer doet


Sub SorteerCRC4()
'
' SorteerCRC4 Macro
'

'

ActiveWorkbook.Worksheets("1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("1").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("1").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("2").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("2").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("2").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("3").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("3").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("3").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("4").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("4").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("4").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("4").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("5").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("5").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("5").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("5").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("6").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("6").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("6").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("6").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("7").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("7").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("7").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("7").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("8").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("8").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("8").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("8").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("9").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("9").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("9").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("9").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


ActiveWorkbook.Worksheets("10").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("10").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("10").Sort.SortFields.Add Key:=Range("B13:B132"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("10").Sort
.SetRange Range("B13:B132")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call SorteerCRC5
End Sub

 

[OctaFish]

Hiij kan zeker kleiner, als je hem opmaakt met de CODE tags. Dus de tag [/code] áchter je code typen, en de tag

[/B] er vóór. Als je dat alsnog wilt doen, dan zou je de mensen een groot plezier doen!

 

[edmoor]

En heb je echt werkbladen met een nummer als naam? En komt die naam dan overeen met het nummer van het werkblad?

 

[Youri92]

ja de de werkbladen zijn zijn genummer 1 tm 120

 

[snb]

zoiets:

sub M_snb()
   for each sh in sheets
       sh.range("B13:B132").sort sh.range("B13"),,,,,,,1
   next
end sub

 

[edmoor]

ja de de werkbladen zijn zijn genummer 1 tm 120

Dat is niet m'n vraag. Ik vraag of het werkblad met de naam "1" ook sheet(1) is en of dat voor alle bladen geldt.

 

[Youri92]

nee naam 1 t/m 120 staat achteraan daarvoor staan nog andere sheets

 

[snb]

sub M_snb()
   for each sh in sheets
       if val(sh.name)>0 then sh.range("B13:B132").sort sh.range("B13"),,,,,,,1
   next
end sub