| 
    
     |  | データには、タイトル行がついていないと思っているので、 先ず、適当なタイトルを追加する処理が入っています。
 Sheet2に抽出後、これの1行目も削除しないとダメでした。
 
 Sub Macro1()
 
 With Worksheets("Sheet1")
 .Rows(1).Insert Shift:=xlDown
 .Range("A1").Value = "col1"
 .Range("A1").AutoFill Destination:=.Range("A1:H1"), Type:=xlFillDefault
 .Range("K1").Value = .Range("E1").Value
 .Range("K2").Value = ">0"
 .Range("A1:H11").AdvancedFilter Action:=xlFilterCopy, _
 CriteriaRange:=.Range("K1:K2"), _
 CopyToRange:=Worksheets("Sheet2").Range("A1"), _
 Unique:=False
 .Range("K1:K2").ClearContents
 .Rows(1).Delete Shift:=xlUp
 .Range("A1").Select
 End With
 With Worksheets("Sheet2")
 .Select
 .Rows(1).Delete Shift:=xlUp
 .Cells(1, 1).Select
 End With
 
 End Sub
 
 
 |  |