| 
    
     |  | ▼くまけん さん: 
 >その”名前”の数万行には例えば、「森田一義」や「四角株式会社」、
 >「日本寺」などがあるため、”株式会社”や”寺”で検索を行って、
 >そのヒットした部分の「Sheet1の行」を削除し、
 >その行をSheet2に上から順に貼り付けていきたいのです。
 
 行削除の件ですが、
 フィルタされた可視行だけをCutして別シートに移動しようとしても、
 表全体がCutされてしまうので、
 可視行を別シートにCopyしておいてから、可視行をDeleteする
 という方法を用います。
 フィルタをかける表のあるシート Worksheets(1)
 コピー先シート         Worksheets(2)
 としますと、
 
 Sub Test2b()
 Dim CopyTo As Range
 Dim StrInput As String
 StrInput = InputBox("抽出文字列")
 If StrPtr(StrInput) = 0& Then Exit Sub
 StrInput = "*" & StrInput & "*"
 
 Set CopyTo = Worksheets(2).Range("A65536").End(xlUp).Offset(1) 'コピー先
 
 With Worksheets(1).Range("A1").CurrentRegion 'フィルタ範囲
 .AutoFilter 1, StrInput          'A列にフィルタをかける
 With Intersect(.Cells, .Offset(1))  '見出し行を除く抽出データ
 .Copy CopyTo           '別シートにコピー
 .Columns(1).EntireRow.Delete   '抽出行を削除
 End With
 .AutoFilter
 End With
 
 End Sub
 
 |  |