|    | 
     こんばんは 
 
あまりに情報が少ないので、それなりのレスしか書けないです。 
「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 
 | 
     
    
   |