VBA：Excelフィルターをかけて１つずつコピーして別シートに１つずつペーストしたい

Question

VBAでオートフィルターをかけて１つずつコピーして別シートにペーストして、１つずつファイルを保存したいのですが、下記の箇所で止まりました。
b.Range("A10").CurrentRegion.Offset(1, 0).Resize(Rows.Count - 1).Copy
どのように修正したら良いかご教示ください。どうぞよろしくお願いいたします。

　　　

「入力シート」　のA列の部名称毎にフィルターにかけて、N列までコピーしたうえで、「部別シート」にペーストして、部別にファイルを作成する。
部名称をU列にコピーして重複削除を行なったうえで、それをキーにしてフィルターをかけました。

「入力シート」イメージ

「部別」シートイメージ

Sub 部別ファイル作成()
     
 Dim i As Integer
 Dim b As Worksheet

 With ThisWorkbook
    Set b = .Worksheets("入力シート")
 End With

      b.Range(Range("A11"), Cells(Rows.Count, 1).End(xlUp)).Copy
      b.Range("U2").PasteSpecial Paste:=xlPasteValues
      b.Range("U:U").RemoveDuplicates 1, xlYes
 
 For i = 2 To b.Cells(Rows.Count, 21).End(xlUp).Row
      b.Range("A10").AutoFilter 1, b.Cells(i, 21)

    Sheets("部別").Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = b.Range("V" & i).Value
    Sheets(Sheets.Count).Range("G1").Value = b.Range("V" & i)
   
    b.Range("A10").CurrentRegion.Offset(1, 0).Resize(Rows.Count - 1).Copy
    Sheets(Sheets.Count).Range("A11").PasteSpecial Paste:=xlPasteValues   
 
    Sheets(Sheets.Count).Copy
    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs "依頼書_" & ActiveSheet.Name & Format(Date, "yymmdd") & ".xlsx"
    ActiveWorkbook.Close

    Sheets(Sheets.Count).Delete
    Sheets("入力シート").Select
 Next
               
End Sub

Answer 1

これでどうでしょうか。

With b.Range("A10").CurrentRegion.SpecialCells(xlCellTypeVisible)
 .Offset(1, 0).Resize(.Rows.Count - 1).Copy
End With

Comments

[SatokoH]

いつもありがとうございます。
いつも わかりやすい構文で大変勉強になります。

今回、教えていただきました構文に差し替えたのですが、
繰り返すなかで 1つ目の部名称では項目ごとペーストされ、
2つ目の部名称では　.Offset(1, 0).Resize(.Rows.Count - 1).Copy　のところでエラーで止まってしまいました。
差し替えるのみではダメでしょうか。

[jinoji]

.Offset(2, 0).Resize(.Rows.Count - 2).Copy
とするとよいかもしれません。
このレイアウトだと9行目もCurrentRegionに含まれるはずなので。

[SatokoH]

ありがとうございます。
２に変更しましたら解決いたしました。