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

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

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

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

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

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

No.5 ベストアンサー 回答者： nishi6 回答日時： 2001/05/02 00:30

できるまで頑張りましょう。

●まず、分類が10まであったら、シートはSheet11まで必要です。(シート数は分類数+1です)
●それに、Sheet1の1行目は表題で、空白セルはなく連続して入力されていて、そのどこかに「分類」という表題があることを前提にしています。
●マクロを動かして、開始、終了入力には半角数値で入力してください。
●標準モジュールを挿入されていれば、先頭行に「Option Explicit」と入力して動かしてみて下さい。スペルミスがあるかもしれません。

いままでに作成したシートをコピーして別名で保存して下さい。そのコピーしたシートを使用しましょう。
１．ＶＢＥ画面で挿入→標準モジュールで標準モジュールを挿入します。既に標準モジュールがあって入力されていれば削除かコメント行にして下さい。
　※コメント行にするには、表示→ツールバー→編集をチェック。出てきたツールバーの「手」の右のアイコンがコメントブロックです。既に入力した行を選んで（反転させて）コメントブロックのアイコンを押します。行頭に「'」が付いてコメントになります。
２．標準モジュールの先頭行に「Option Explicit」がなかったら「Option Explicit」を入力します。
３．ANO.#4のマクロ部分を選んでコピーして下さい。
　　Public Sub から End Sub　までです。
４．これを標準モジュールに貼り付けます。
　※文章から判断して、マクロを入力されたと思いますので、スペルミスをなくすために貼り付けてください。マクロの行を見て、「xxx」と「End xxx」、「For xxxx」と「Next」に挟まれた行を選択してTABキーを押していくと見やすくなります。（インデントをつける）ｏｋｗｅｂからメールが届いていれば、そちらを貼り付ければ見やすくなると思います。
５．Excelシートに戻って、ツール→マクロ→マクロで「BunruiSheetPrint」を選んで実行します。
６．開始行と終了行を半角数値で入力してください。
うまくいきますように。

うまく動いたら
　　Dim rw → Dim rw As Long '行カウンタ
　　Dim br → Dim br As Integer '各データの分類
　　Dim ws → Dim ws As Worksheet '印刷をするシート
に修正して下さい。今のままでも動きますが、ここはこう書くべきでした。

＞やっぱり、初心者では無理ですか？
そんなことはないと思います。最初はみんな初心者ですし。ruru-Kさんもこれだけ考えていれば上達しているはずです。基本を身に付けること（本とかで）と考えることでどんどん上達していくはずです。多分もう少しで動きます。(私の方に間違いがなければ？)頑張って下さい。

この回答へのお礼

nishi6さん！！ うごきました！！ ありがとうございます。感動の一瞬でした！

これから、いろんな機能等をつけて暑中見舞いに間に合うように完成させます。
HLOOLUPを使わずに、シートに飛ばせば！？ と言うアドバイスを頂いたおかげでＶＢＡの事も少しずつ分かってきました。なんだか自信がでてきました。やれば出来る！ とはいっても、まだ理解できているわけではありません。もっと勉強していきたいと思います。本当にありがとうございました。

で・・・ソフトとして使い易いように、いろいろ考えているのですが、いきなり問題が出来ました。それは、各分類のシート（はがきのフォーム）を表示させて、１枚ずつ体裁を確認しながら印刷させる事も出来るようにしたい。ということです。
「（次の宛名→印刷）を繰り返していく」のように・・・

１回の質問でいろいろ聞くのも、なんだか申し訳なくなってきましたので、一旦締め切ります。この後すぐ、「 分類に分けられたシートの表示 」と言うタイトルで質問をさせていただきますので、宜しくお願い致します。

お礼日時：2001/05/03 07:46

No.4 回答者： nishi6 回答日時： 2001/04/27 22:28

紛らわしい表現を使ったかもしれません。

すいませんでした。「+」を使って・・・とういのは、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'シート番号を求める」 のところの行に網掛けが出ます。なぜでしょうか？

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

補足日時：2001/05/01 16:09

No.3 回答者： nishi6 回答日時： 2001/04/27 10:13

＞よろしかったら送り込みの方法を教えていただけませんでしょうか？

しばらくお待ち下さい。

この回答への補足

承知致しました。待ちます。
とりあえず、私もいろいろ試してみます。試してはいますが、今のところエラーばかりで、全く前に進んでいません。宜しくお願い致します。

補足日時：2001/04/27 18:03

No.2 回答者： nishi6 回答日時： 2001/04/25 01:15

＞移動を自動的にさせたいのですが

に対して、下記のVBAを書いてみました。参考にして下さい。詳細が分からないので条件があります。
１.データはSheet1にある
２.Sheet1の１行目は表題になっており(A1から)、全ての列に入力されていて、どこかに「分類」という表題がある。
３.「分類」列は全てのデータについて入力されていて1からシート数-1以下である。
注１）転記するシートには２行目から書いています。
注２）分類が増えたらシートを増やします。VBAは修正不要です。
注３）データの増減、修正がある場合、Sheet2以降はデータをクリアする必要があります。
　　（これがあるためこの方法には抵抗があります。初期化すればいいんですが）

Public Sub Sheet2Sheet()
Dim BunruiCol As Integer '分類が入力された列(A列からのカウント)
Dim columnMax As Integer '列数(データ項目数)
Dim rowMax As Integer '行数(データ数)
Dim cl, rw As Integer 'カウンタ
Dim wRw(255) As Integer '各シートで書いた行番号(2行目からスタート)
'分類の列位置、データ列数・行数を調べる
With Worksheets("Sheet1")
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
rowMax = .UsedRange.Rows.Count - 1
End With
'各シートに転記
Dim br '各データの分類
With Worksheets("Sheet1").Range("A1")
For rw = 1 To rowMax
br = .Offset(rw, BunruiCol) + 1
For cl = 0 To columnMax
Worksheets("Sheet" & br).Range("A1").Offset(wRw(br) + 1, cl) = .Offset(rw, cl)
Next
wRw(br) = wRw(br) + 1
Next
End With
End Sub

＞もっと良い方法があったらそれも教えて下さい。
に対して、私なりの感想ですが（やるとしたらこうします）
（1）分類数に対応するハガキフォームを先に作ってしまいます。各シートは１分類としSheet2から作ります。１行目(A1から)にデータを適当に入力しておき、それを「+」を使ってレイアウトに編集していきます。肝心なのはここをいかにシンプルに作るか、分類が増えた場合も考え簡単に対応できるようにしておきます。
（2）できたハガキフォームの印刷範囲をシート単位で決定します。
（3）後は、上記ＶＢＡのように各シートに移動させるわけすが、該当シートに１件単位に書き込み（１行目に）→そのシートをアクティブに→印刷　を繰り返していきます。ＶＢＡは当然、シート数が増えても手を入れなくていい作りにします。（上記ＶＢＡもそうです）
（4）印刷時は全件印刷や指定印刷が必要でしょうからその機能を付加します。
ざっと書きましたが、印刷はExcelに任せ、１件を該当シートに送ってやれば、１シート１分類、１データとなりリンクもHLOOKUPも不要な気がします。
長々と書いてしまいました。がんばってください。

この回答への補足

大変参考になる回答をありがとうございます。
早速、試してみましたところ、うまくいきました。が・・・
ご意見いただきました通り、1件を該当するシートへ送る方法で進めたいと思います。
その内容について詳しく知りたいのですが、現在、ハガキのフォームはできました。ただ、1行目にデータを適当に入力しておき、「＋」でレイアウトに編集？と言う部分が良く分かりませんでした。（とりあえずフォームは出来てますが・・・）ここまでは何とかうまくいってますが、そのフォームにそれぞれの該当データを、HLOOKUPを使用せずに送り込む作業をしているのですが、なかなかうまくいきません。私の単なる知識不足でしょうが・・・
ＶＢＡに関して、初心者なものですみません！よろしかったら送り込みの方法を教えていただけませんでしょうか？よろしくお願い致します。

補足日時：2001/04/25 18:17

No.1 回答者： TTak 回答日時： 2001/04/24 23:56

ruru-kさんこんにちは。

見たところ、ずいぶんややこしいなぁと思いましたが、私も似たようなことをやっています（笑）。私の場合、各シートごとに色々なフォーマットを作ったら半端じゃないファイル容量になったので、データだけ１つのシートにまとめて、マクロで、値のみを各シートに貼り付けていくというものです。各シートには参照式や関数などがあって、値が貼り付けられると同時に、計算結果が表示される仕組みです。おおかた、同様の内容ではないでしょうか・・・。
さて、やはりVBAを使った方がよさそうです。そしてポイントになると思われるステートメントを２つを述べます。
まず、”分類”のフィールドに入力された数値をキーとして、各シートに配分されるようですが、"For ～ Next"ステートメントと、"Select Case ～ End Select"ステートメントを使ってはいかがでしょう。例えば列Eの値を１行目から順々に調べていくパターンだと・・・。

Sub test()
'---5列目の最下段を取得
n = Range(Cells(ActiveSheet.Rows.Count, 5).End(xlUp).Address).Row + 1
'---5列目の値ごとに処理を分岐
For i = 1 To n
Select Case Cells(i, 5).Value
Case 1: MsgBox "シート2へコピーするマクロ"
Case 2: MsgBox "シート3へコピーするマクロ"
Case 3: MsgBox "シート4へコピーするマクロ"
Case Else
End Select
Next i
End Sub

なんてコード例が考えられます。
ハンドラとして記入したMsgBoxの所には実際のマクロやマクロ名（サブルーチンの場合）を入れてください。"シート?へコピーするマクロ"なる部分は、自動記録なんかで作成できるでしょうし、CopyやPasteなどをキーワードにヘルプで調べてください。

この回答への補足

TTakさん ありがとうございます。
はやりややこしいことなんですね！ＶＢＡについて初心者なのでなかなか思うようにいきません。参考にさせていただきながら思考錯誤しています。少しずつですが分かってはきているのですが、1歩進んでは、3歩下がり、ってかんじです。とりあえず完成させたいので頑張ります。なにかヒントがあったらまたお願いします。

補足日時：2001/04/25 18:36