如何在不更改SUM的情况下重新排序

Question

下面的代码对一张工作表中特定范围内的一组值进行重新排序，以匹配另一张工作表（在数据透视表中）。 问题在于，当重新排序时，它会更改相邻行中的SUM公式。我该如何预防？

Sub Reorder()


Dim First As String
Dim Range1 As Range
Dim Range2 As Range
Dim lRow As Long
Dim Count As Long
Dim Net As String
Dim Line As Range
Dim Netrng As Range
Dim Swith As Range

    If ActiveCell.Column = 2 Then
    First = ActiveCell.Address
    ActiveWindow.ActivatePrevious

    ActiveSheet.Range("B5").Activate
    lRow = Cells(Rows.Count, 1).End(xlUp).row - 6
    Set Range2 = Range(ActiveCell.Offset(3, -1), ActiveCell.Offset(lRow, -1))


    Count = 1
      While Count <= Range2.Count
      Set Line = Range2.Rows(Count)
      Net = Line.Value


      ActiveWindow.ActivatePrevious

      Set Range1 = Range(First, Range(First).End(xlDown))
      Range1.Activate
      Set Netrng = Range1.Find(What:=Net, After:=ActiveCell, LookIn:=xlValues, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False)


      If Not Netrng Is Nothing And Netrng.row <> Range1.Rows(Count).row Then
       Rows(Netrng.row & ":" & Netrng.row).Select
       Selection.Cut
       Rows(Range1.Rows(Count).row & ":" & Range1.Rows(Count).row).Select
       Selection.Insert Shift:=xlDown
      End If
      ActiveWindow.ActivatePrevious
      Count = Count + 1
      Wend
 Else
MsgBox "Please select correct column"
End If


End Sub