Macro aangepast sorteren met variabel aantal rijen daarna subtotalen invoegen

Beste Excellers,

Ik heb dagelijks een bestand aan te passen met dezelfde kolomindeling maar met een variabel aantal rijen.
Het betreft aangepast sorteren, en subtotalen invoegen.
Met de macro recorder heb ik deze stappen opgenomen.

De macro werkt niet goed omdat het aantal rijen elke dag anders kan zijn, dus F23 kan morgen bijv. F30 zijn.
Kan iemand mij helpen met de macro aan te passen die voor het sorteren en subtotalen rekening houdt met deze
variabel aantal rijen?

Mvgr. André

Sub Sorteer()
'
' Sorteer Macro
'
' Sneltoets: Ctrl+s
'
Range("A2:F23").Select
ActiveWorkbook.Worksheets("voorbeeld").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("voorbeeld").Sort.SortFields.Add Key:=Range( _
"F3:F23"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("voorbeeld").Sort.SortFields.Add Key:=Range( _
"E3:E23"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
ActiveWorkbook.Worksheets("voorbeeld").Sort.SortFields.Add Key:=Range( _
"C3:C23"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("voorbeeld").Sort
.SetRange Range("A2:F23")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.Subtotal GroupBy:=6, Function:=xlCount, TotalList:=Array(6), _
Replace:=True, PageBreaks:=True, SummaryBelowData:=True
ActiveSheet.PageSetup.PrintArea = "$A$2:$F$31"
End Sub

Met deze formule kan je kijken wat de laatste cel is met een waarde in een kolom.

lr = data.Cells(Rows.Count, 1).End(xlUp).Row + 1

Hoop dat je hier wat mee kan

Als ik de code goed bekijk denk ik dat deze niet volledig is.
Ik weet ook niet waar ik deze in moet voegen..

Plaats svp de code tussen codetags.

Bedankt VenA

Dit is wat ik zocht.