マクロの作り方で質問です。

添付写真のように、B列にフィルターをかけて、
みかんだけのフィルターで印刷
りんごだけのフィルターで印刷
以下繰り返し

と、フィルター上で選べるものを全て
自動で印刷するようなマクロは作れますでしょうか？

数百件もあるので、
可能であれば、作っていただければとても助かります。

よろしくお願い致します。

質問者からの補足コメント

• 

  どうもありがとうございます。うまくできました。
  
  もう一つ教えていただきたいのですが、
  今回はB2のフィルターを全て印刷しましたが、
  例えば、C２のフィルターを全て印刷したい場合は、
  このマクロのどこを直せばよろしいでしょうか？
  
  恐れ入りますが、ご教示のほど宜しくお願い致します。

  No.2の回答に寄せられた補足コメントです。 補足日時：2023/10/17 08:40

No.2 ベストアンサー 回答者： 河内のおやじ 回答日時： 2023/10/15 23:52

Sub PrintFilteredData()

Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim filterRange As Range
Dim uniqueItems As Collection
Dim item As Variant

Set ws = ThisWorkbook.Sheets("シート名") ' "シート名" を自分のシート名に変更してください
Set rng = ws.Range("A1").CurrentRegion
Set filterRange = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
Set uniqueItems = New Collection

On Error Resume Next
For Each cell In filterRange.Columns(2).Cells
If cell.Value <> "" Then
uniqueItems.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0

For Each item In uniqueItems
ws.AutoFilterMode = False
filterRange.AutoFilter Field:=2, Criteria1:=item

' ここに印刷のコードを挿入してください
' 例えば、次の行はアクティブなウィンドウでの印刷を行います
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ws.AutoFilterMode = False
Next item
End Sub

この回答へのお礼

ありがとうございます。やってみます。また質問するかもしれないです。よろしくお願いいたします。

お礼日時：2023/10/16 22:23

No.1 回答者： fujillin 回答日時： 2023/10/15 23:51

こんばんは

ループ（＝繰り返し処理）の概念と、最終行の求め方くらいをご存じなら、あとは「マクロの記録」で6～7割はできますので、それを修正すれば可能です。
「～～くらいをご存じなら」についても、検索すれば沢山の情報が見つかると思います。

以下に、簡単な考え方と手順の例を。
フィルター対象の項目の全種類を調べるには、Ｂ列の値の「重複を除いた項目一覧」が必要になります。

「マクロの記録」を利用して、
　1-1）適当な空き列を作業列にして、Ｂ列をコピペ
　1-2）作業列で「重複を削除」を行う
これにより、上記の一覧を作成できます。

　2-1）例えば「みかん」でフィルターをかけて印刷する
　2-2）フィルターを解除
してみると、「みかん」の場合の「1回分の印刷処理」を作成できます。

この「1回分の印刷処理」の「みかん」の部分を、「項目一覧」のリストの順に入れ替えて処理するように修正すれば、お望みの内容のマクロを作成可能と思います。


※ 「そんなかったるいことやってられるか！」という場合は、質問者様の代わりに作業をしてくれる方が、どなたか現れるのをお待ちください。