VBA複制拆分工作表調用excel公式

Sub BJ_Union删除大區_彙總款式銷售資訊并排序()
Application.DisplayAlerts = False
Dim St1 As Object, St2 As Object, Cel As Object, Rng As Object
Dim Row1 As Integer

'每次運作程式之前,删掉之前生成的排名表
For Each St1 In Sheets
    If Right(St1.Name, 2) = "排名" Then  '判斷表名最後兩個字元是否是"排名"
        St1.Delete
    End If
Next

'複制資料表,并命名
Sheets("案例資料").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "北京地區款式實銷金額排名"

'擷取行數
Set St2 = ActiveSheet
Row1 = St2.Range("A65536").End(xlUp).Row '排名表的行數

'删除其他大區
If St2.FilterMode = True Then St2.ShowAllData '取消篩選和隐藏
Set Rng = St2.Cells(St2.Cells.Rows.Count, "f") '初始時給rng增加一個沒用的資料
For Each Cel In St2.Range("F2:F" & Row1)
    If Left(Cel.Value, 3) <> "190" Then Set Rng = Union(Rng, Cel)
Next
Rng.EntireRow.Delete

'填充款号彙總公式
'St2.Range("l1").Value = "款号"
'St2.[M1].Value = "款式銷量"
'St2.[N1].Value = "款式零售金額"
'St2.[O1].Value = "款式實銷金額"
Row1 = St2.Range("A65536").End(xlUp).Row '排名表的行數

St2.Range("L1:O1").Value = Split("款号 款式銷量 款式零售金額 款式實銷金額", " ")
St2.Range("L2").Formula = "=LEFT(E2,LEN(E2)-5)"
St2.Range("M2").Formula = "=SUMIF($L:$L,$L2,H:H)"
'填充公式
'St2.Range("M2").AutoFill Destination:=St2.Range("M2:O2")
'St2.Range("L2:O2").AutoFill Destination:=St2.Range("L2:O" & Row1)
St2.Range("M2").Copy
St2.Range("N2:O2").PasteSpecial Paste:=xlPasteFormulas
St2.Range("L2:O2").Copy
St2.Range("L2:O" & Row1).PasteSpecial Paste:=xlPasteFormulas
'把公式選擇性粘貼成數值
St2.Range("L:O").Copy
St2.Range("L:O").PasteSpecial Paste:=xlPasteValues
'删除款号重複項
St2.Range("A1:O324").RemoveDuplicates Columns:=Array(12), Header:=xlYes
'删除多餘列
St2.Range("C:K").Delete
Row1 = St2.Range("A65536").End(xlUp).Row '排名表的行數
'按照款式實銷金額進行排序
St2.Range("A1:F" & Row1).Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlYes


Application.DisplayAlerts = True
End Sub