オートフィルタで抽出したデータをVBAで貼り付けしたい

質問

質問させていただきます。

エクセルで仕入帳を作っています。
各取引先ごとに1枚のシートになっているのですが、
該当する月をオートフィルタで抽出して、そのデータを1枚のシートに貼り付けていき、各月ごとにデータをまとめたいと思っています。

ユーザーフォームで月を入力してオートフィルタで抽出しているのですが、データのないシートの場合不要な部分までコピー＆ペーストされてしまいます。

これを回避するにはどのようにコードをかけばいいのでしょうか。

よろしくお願い致します。
現在はこのようなコードで抽出しています。

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

Worksheets("sheet2").Select

Range("H1:H17").Select
Range("H17").Activate
Selection.AutoFilter Field:=8

Rows("2:2").Select
Rows("2:500").Select
Selection.ClearContents

RowIndex = 3 '行番号の初期値設定

Do While Worksheets("目次").Cells(RowIndex, 1).Value <> "" '拾ったセルの値が空でない間ループ内の処理をする
検索値 = UserForm1.TextBox1.Text
DataSheetName = Worksheets("目次").Cells(RowIndex, 1).Value

Worksheets(DataSheetName).Select

Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter

Selection.AutoFilter Field:=13, Criteria1:=検索値 & "月分"

Set tbl = ActiveCell.CurrentRegion
tbl.Offset(2, 0).Resize(tbl.Rows.Count - 2, tbl.Columns.Count).Select
Selection.Copy

Worksheets("sheet2").Select
IRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A" & IRow + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Worksheets(DataSheetName).Select
Selection.AutoFilter Field:=13

RowIndex = RowIndex + 1 '行番号カウントアップ
Loop
Application.ScreenUpdating = True

Worksheets("sheet2").Select
Range("A2").Select

Unload UserForm1
End Sub

回答No.1

mitarashi · ベストアンサー

すみませんが、コードは真面目に読んでないです。
>オートフィルタで抽出しているのですが、データのないシートの場合
>不要な部分までコピー＆ペーストされてしまいます。
これはオートフィルターで、一件も抽出されなかった場合という意味でしょうか。
それなら、オートフィルターのかかっている範囲で抽出された行数を調べて、処理を分岐すれば良いと思います。SpecialCells(xlCellTypeVisible)だと、Areaが分かれていて面倒なので、
Sub test()
Dim targetrange As Range
Set targetrange = Sheets(1).Cells(1).CurrentRegion
Debug.Print Application.WorksheetFunction.Subtotal(3, targetrange.Columns(1))
End Sub
が良さそうです。
外していたらすみません。

お礼

回答が遅くなりすみません。

やっぱりどうしてもうまく動きませんでした。
もう一度よく考えて書き直してみたいと思っているのですが、なかなか時間がとれません。

がんばって勉強してみます。