Configure sort for variable row count

[rebubula]

Hi. I would like this macro to allow sorting for files with a variable row count. How do I fix the range?

Sub Proofing()
'
' Proofing Macro
' Arrange columns for the proofing process
'
' Keyboard Shortcut: Ctrl+Shift+W
'
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Data Check"
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:T").Select
    Selection.Delete Shift:=xlToLeft
    Columns("S:S").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("P:T").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:O").Select
    Selection.Cut
    Columns("C:D").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:L").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "B2:B6641"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "C2:C6641"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "D2:D6641"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "F2:F6641"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "G2:G6641"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "E2:E6641"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Proofing").Sort
        .SetRange Range("A1:AQ6641")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub

Thanks in advance!

 

[taurean]

Make a backup copy first and then test this:

Sub Proofing()
'
' Proofing Macro
' Arrange columns for the proofing process
'
' Keyboard Shortcut: Ctrl+Shift+W
'
    Dim lLastRow As Long
    lLastRow = Range("B" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = "Data Check"
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("H:J").Delete Shift:=xlToLeft
    Columns("I:L").Delete Shift:=xlToLeft
    Columns("J:T").Delete Shift:=xlToLeft
    Columns("S:S").Cut
    Columns("B:B").Insert Shift:=xlToRight
    Columns("P:T").Delete Shift:=xlToLeft
    Columns("N:O").Cut
    Columns("C:D").Select
    ActiveSheet.Paste
    Columns("E:E").Cut
    Columns("C:C").Insert Shift:=xlToRight
    Columns("L:L").Delete Shift:=xlToLeft
    Columns("K:L").Cut
    Columns("B:B").Insert Shift:=xlToRight
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "B2:B" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "C2:C" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "D2:D" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "F2:F" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "G2:G" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Proofing").Sort.SortFields.Add Key:=Range( _
        "E2:E" & lLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Proofing").Sort
        .SetRange Range("A1:AQ" & lLastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

[rebubula]

Thank you!!