| 
    
     |  | こんばんは 
 あまりに情報が少ないので、それなりのレスしか書けないです。
 「Worksheet_Activate」イベントの話しはちょっと置いといて、
 
 「データ」というシートの1行目に項目名が有るとします。
 
 A    B   C    D   E ・・・・IV
 1 項目1  項目2  項目3
 2 甲  25.33% 36.00%
 3 乙  32.67% 25.84%
 
 IV列を一時的に作業列として使用します。
 
 C列の方が5%以上大きければ、"以上"という名のシートに転記
 -5%以下であれば、"以下"という名のシートに転記します。
 
 Sub test()
 Dim cR As Range
 Application.ScreenUpdating = False
 With Worksheets("データ")
 Set cR = .Range("IV1:IV2")
 cR(2, 1).Formula = "=(C2-B2)<=-0.05"
 .Range("A1").CurrentRegion.AdvancedFilter _
 Action:=xlFilterCopy, _
 CriteriaRange:=cR, _
 CopyToRange:=Worksheets("以下").Range("A1:C1"), _
 Unique:=False
 cR(2, 1).Formula = "=(C2-B2)>=0.05"
 .Range("A1").CurrentRegion.AdvancedFilter _
 Action:=xlFilterCopy, _
 CriteriaRange:=cR, _
 CopyToRange:=Worksheets("以上").Range("A1:C1"), _
 Unique:=False
 End With
 cR.Delete xlShiftUp
 Set cR = Nothing
 Application.ScreenUpdating = True
 End Sub
 
 |  |