Dim DBシート, 基点セル, 抽出列, 抽出キー
Dim 別シート, コピー先キー
Dim コピー先シート As Worksheet
Dim 抽出範囲 As Range
Dim 領域 As Range
Dim 行数
'オートフィルターで抽出
    DBシート = "sheet1"
    基点セル = "A1"
    抽出列 = 2
    抽出キー = txtPeji.Text
    With Worksheets(DBシート)
        .Activate
        If .AutoFilterMode Then                 'オートフィルタモードがオンなら
            Selection.AutoFilter                'リセットする
            End If
    End With
    Range(基点セル).AutoFilter field:=抽出列, Criteria1:=抽出キー
'データがない場合
    Set 領域 = Range(基点セル).CurrentRegion
    行数 = 領域.Columns(1).SpecialCells(xlCellTypeVisible).cell.Count - 1 '★★
    If 行数 = 0 Then
        MsgBox "一致するデータはありません"
    Else
'抽出結果をコピーする
        Worksheets("抽出").Cells.Clear          '抽出シートのクリア
        別シート = "抽出"
        コピー先セル = "A1"
        Set コピー先シート = Worksheets(別シート)
        Set 抽出範囲 = Worksheets(DBシート).Range(基点セル).CurrentRegion
        コピー先シート.Cells.Clear
        With 抽出範囲
            .Resize(.Rows.Count - 1).Offset(1).Copy _
                Destination:=コピー先シート.Range(コピー先セル)
        End With
    End If
    Worksheets("sheet1").AutoFilterMode = False 'オートフィルタオフ