エクセルの表を自動的に、項目毎に別シートへ分ける方法

質問

住所録に分類をつけて、その分類毎に別のシートへコピー又は、移動を自動的にさせたいのですが、なにか良い方法がありましたら教えて下さい。まだ初心者ですが、エクセルＶＢＡでも構いません。宜しくお願い致します。

例） 氏名 ・・ 会社名 ・・役職 ・・住所 ・・・ 分類
○○○○ ・ －なし－ ・ なし ・ あああああ ・ １ → シート２へ
×××× ・ いいいい ・ 社長 ・ えええええ ・ ２ → シート３へ
－な し－ ・ ええええ ・ なし ・ おおおおお ・ ３ → シート４へ

※分割後、別シートのハガキフォームへリンクするしくみを作成中です。
上記の様に、パターンがいろいろあって、その分類毎にハガキフォームを用意して、それぞれをリンクさせようとしています。リンクの方法は、HLOOKUPを使用しています。
フォームへの宛名表示は、ＶＢＡでレコードＮＯ指定のセル＋１のプログラムを組み、これを、ボタンにマクロを登録して次のデータへ進む様に作成しています。
住所録は、登録するデータが多い為、入力の楽なエクセルで一覧（1シート）にしています。

市販のソフトやフリーソフトでは、なかなか対応出来るのがなく、ワードの差込印刷も試しましたが、1枚づつの調整が面倒でしたので、簡単なものを作成しようと思い頑張っていますが、今のところ、これしか思い付かないのですが、もっと良い方法があったらそれも教えて下さい。

説明が、下手ですみません。宜しくお願い致します。

回答No.4

nishi6

紛らわしい表現を使ったかもしれません。すいませんでした。「+」を使って・・・とういのは、1行目にあるデータをレイアウトの中に配置するだけという意味で使いました。私自身、別のセルにデータを入れる場合、「=」を余り使わないのでこういう表現をしてしまいました。(F10にA1のデータを入れる場合、F10には+A1としています。)
さて、ご質問の件ですが、下記VBAを作ってみました。前提としては、各分類のシートで印刷ができれば動くと思います。今は画面表示PrintPreviewにしてあります。PrintOutにすれば印刷できるはずです。簡単な範囲指定・入力チェックも入れておきました。処理自体はだいぶ単純化されたと思いますがどうでしょうか？何か不具合が合ったら補足してください。

Public Sub BunruiSheetPrint()
Dim ws1 As Worksheet 'Sheet1
Set ws1 = Worksheets("Sheet1")
Dim BunruiCol As Integer '分類が入力された列(A列からのカウント)
Dim columnMax As Integer '列数(データ項目数)
Dim cl As Integer '列データ用カウンタ
'分類の列位置、データ列数を調べる
With ws1
With .Range("A1")
While .Offset(0, cl) <> "" And BunruiCol = 0
If .Offset(0, cl) = "分類" Then
BunruiCol = cl
End If
cl = cl + 1
Wend
End With
columnMax = .UsedRange.Columns.Count
End With

Dim dmy As String '入力用ワーク文字
Dim startRow As Long '開始行
Dim lastRow As Long '最終行
'印刷開始から最終行を入力(このあたりは処理例です。)
dmy = InputBox("印刷開始行を入力します")
If dmy <> "" Then startRow = Val(dmy)
dmy = InputBox("印刷最終行を入力します")
If dmy <> "" Then lastRow = Val(dmy)
'開始<=最終 ?　（これもチェック例です）
If Not (startRow <= lastRow) Then
MsgBox "エラー", vbOKOnly, "誤入力": Exit Sub
End If
'
'各シートに飛ばす(Sheet2から。Sheetは連番)
Dim rw '行カウンタ
Dim br '各データの分類
Dim ws '印刷をするシート
Application.ScreenUpdating = False 'シート表示を固定
With ws1.Range("A1")
For rw = startRow To lastRow '指定した範囲を印刷
br = .Offset(rw, BunruiCol) + 1 'シート番号を求める
Set ws = Worksheets("Sheet" & br) 'シートを決定
For cl = 0 To columnMax '1行分目的のシートに書く
ws.Range("A1").Offset(0, cl) = .Offset(rw, cl)
Next
ws.Activate
'PrintPreview を PrintOut に変えれば印刷を実行
ActiveSheet.PrintPreview
Next
End With
Application.ScreenUpdating = True 'シート表示の固定解除
ws1.Activate 'Sheet1を表示
End Sub

補足

nishi6さん、回答ありがとうございます。
すみません理解できません！ とりあえず、VBAを打ち込んでみましたが、うまくいきません。エラーで、デバックをクリックすると 「br = .offset(rw,BunruiCol)+1'シート番号を求める」 のところの行に網掛けが出ます。なぜでしょうか？

やっぱり、初心者では無理ですか？ 何度もお尋ねして申し訳ございませんが、もし、初心者でも出来る範囲でしたら、もう少し詳しく教えていただけませんでしょうか？ 私も、もっと勉強してみますので、宜しくお願い致します。