Sort methode activeworkbook

[harolda1980]

Deze code is volgens mij vrij groot en met de select methode ook niet al te stabiel. Hoe kan ik dit veranderen. Nu moet ik namelijk het blad echt selecteren. Is hier een andere weg voor?

Sub sorteerR1()
Dim r As Range
Application.ScreenUpdating = False
Sheets("r1").Select
 
Set tbl = Sheets("r1").Cells(9, 1).CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Set r = ActiveCell
 
For rijrapL = 10 To 3000 'Laste rapport regel opzoeken
If Sheets("r1").Cells(rijrapL, 2).Value = "" Then RS = rijrapL - 1
If Sheets("r1").Cells(rijrapL, 2).Value = "" Then GoTo Selectiemaken
Next rijrapL
Selectiemaken:
 
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Add Key:=Range(Cells(10, 1), Cells(RS, 1)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Add Key:=Range(Cells(10, 3), Cells(RS, 3)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Add Key:=Range(Cells(10, 2), Cells(RS, 2)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("r1").Sort
        .SetRange Range(Cells(10, 1), Cells(RS, 10))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-18
End Sub

 

[Superzeeuw]

Even een snelle aanpassing zonder voorbeeld bestand:

P.s.: als het nu niet werkt plaats dan even een voorbeeld bestand, dat praat meestal wel makkelijker.

Sub sorteerR1()
Application.ScreenUpdating = False
rijrapL = Sheets("r1").Range("A1", ActiveCell.SpecialCells(xlLastCell)).row

    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Add Key:=Range(Cells(10, 1), Cells(rijrapL, 1)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Add Key:=Range(Cells(10, 3), Cells(rijrapL, 3)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("r1").Sort.SortFields.Add Key:=Range(Cells(10, 2), Cells(rijrapL, 2)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("r1").Sort
        .SetRange Range(Cells(10, 1), Cells(rijrapL, 10))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-18
End Sub