macro - forskellige antal liner ?

Hej,
Jeg har et excel ark hvor jeg fremhæver et vis antal liner med en farve, det kan være forskellige antal linjer der er farvet fra gang til gang når jeg køre min makro, og den så laver en sammentællning i nogler celler men jeg får et forkert efter jeg har kørt min makro hvis ikke antallet af linjer er det samme som den makro jeg har indspillet, både flere linjer + færre antal linjer...

Er der en som har en god ide til hvordan jeg kan løse dette "problem",
så jeg kan køre min makro og få samme sammentælling lige meget hvor mange eller få liner jeg har farve markeret fra gang til gang ?

Tak på forhånd for hjælpen :)


Sub Sortbycolors()
'
' Sortbycolors Macro
'
' Keyboard Shortcut: Ctrl+m
'
    ActiveWorkbook.Worksheets("2023_IMPORT_data 31.05.23").AutoFilter.Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("2023_IMPORT_data 31.05.23").AutoFilter.Sort. _
        SortFields.Add(Range("A16:A1687"), xlSortOnCellColor, xlAscending, , _
        xlSortNormal).SortOnValue.Color = RGB(255, 192, 0)
    With ActiveWorkbook.Worksheets("2023_IMPORT_data 31.05.23").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("32:32").Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Range("F32").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
    Range("F33").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    Range("F32").Select
    Selection.AutoFill Destination:=Range("F32:M32"), Type:=xlFillDefault
    Range("F32:M32").Select
    Range("K32").Select
    Selection.ClearContents
    Range("I32").Select
    Selection.ClearContents
    Range("J32").Select
    Selection.ClearContents
    Range("H32").Select
    Selection.ClearContents
    Range("L33").Select
End Sub