データ抽出＆シート追加

Sub prog4_1()
    Dim myFld As String, myCri As String
    Dim myRow As Long
    
    
    
        myFld = InputBox("検索は何列目ですか?")
        myCri = InputBox("検索する語句を入力しなさい")
        
        'シート追加とシート名を抽出にする
        Worksheets.Add
        ActiveSheet.Name = "抽出"
        
        'オートフィルタでデータを抽出する
        Worksheets("データ").Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri
        
        '抽出データの最終行を求める
        myRow = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
        
        '抽出先をクリアする
        Worksheets("抽出").Range("A:Q").ClearContents
        
        '抽出データをコピーして貼り付け
        Worksheets("データ").Range("A1:Q" & myRow).Copy Worksheets("抽出").Range("A1")
        
        'オートフィルタを解除
        Worksheets("データ").Range("A1").AutoFilter
        
       
       'シート名変更
        Worksheets("抽出").Name = Worksheets("抽出").Range("H2") & Worksheets("抽出").Range("G2")

        
End Sub