| 
    
     |  | ▼なかちゃん 取りあえず押入れの中から昔使ってたサンプル見つけたので送ります
 使ってみて
 Sub 特定文字列を含むデータの抽出()
 
 Dim Moji As String        '検索する特定の文字列
 Dim Jouken As String       '抽出条件
 Dim WS1 As Worksheet
 Dim WS2 As Worksheet
 
 Moji = "交通費" とか        '検索する特定の文字列を取得
 
 Jouken = "*" & Moji & "*"     '抽出条件の作成
 Set WS1 = Sheets("Sheet1")
 Set WS2 = Sheets("Sheet2")
 
 Application.ScreenUpdating = False     '画面の更新を停止
 
 With WS2
 .Activate                '抽出先のSheet2の表示
 .Columns("B:D").Clear          '抽出先のSheet2のデータを消去
 End With
 
 With WS1
 
 '特定文字列を含むデータの抽出
 .Range("B3").AutoFilter Field:=1, Criteria1:=Jouken
 
 '抽出したデータをSheet2へコピー
 .Range("B3").CurrentRegion.Copy Destination:=WS2.Range("B3")
 
 .Range("B3").AutoFilter 'オートフィルタの解除
 
 End With
 
 Application.ScreenUpdating = True '画面の更新を有効
 
 End Sub
 
 範囲、項目当追加書き換えが必要応用できるかな
 自分で一度サンプルを作るといい
 
 |  |