１行を１シートずつに書き出すには

質問

顧客データのシートがあります。
１人分のデータが１行になっていて、３００行ほどあります。
顧客１人ずつのデータを１シートごとに分割して、
３００シートを書き出したいのですが、
どのようにすればできるでしょうか。
この際、できれば、シート名は顧客名に、
１行は１列に変換して（行列入れ替え）できれば、なお嬉しいのですが…

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

回答No.3

imogasi

質問そのままに受け取ってやるとして
まずやり方だが
（１）VBAでもできる（質問者はVBAの経験あるのかな）
多分無いのでしょう。既出回答も役に立つのかな。
（２）関数でもできる（ちょっと手間だが）
下記に説明してみる。
ーー
しかし、根本論として
多分質問者はシステムの素人で、自分の考えでこういう質問をしているように思えてならない。
なぜなら今までシステムにかかわったものは、エクセル３００行のレコードを３００シートなぞにしません。
１行データでー＞１画面に組み立てー＞１枚印刷ー＞３００回繰り返し
といったパターンでやってきたからです。
１人を指定して表示するときも、人に割り当てたコードで検索ー＞その人のデータ行を見つけるー画面に（見やすく編集して）表示
別の人の指定がでたなら、内容（コード）を変えて同様作業をプログラムで繰り返す
とすることが多い。
ーー
関数では
（１）原データ（表の）の各行に連続番号を振る
ーー
（２）１シートを（見本的に）作る。
標題や見出しや書式や様式（フォーマット）を好みのものに
作る
（３）そして
関数式を入れる。それは
（４）（１）の連番で引くVLOOKUP関数を用いて、原データ表の各列の項目を（２）のフォーマットの中の該当のセルに入れる。
（５）各シートで連番を入れるセル（同一位置であること、下記例ではG1）を決めておく。
（６）シートを３００枚コピー
手間だが１－＞２－＞４－＞８・・
と操作でコピーする方法はある。１０回ぐらいで３００シートを越える。
（７）各シートの（５）のセル（下記例ではG1)に1,2,3、・・を入れる。
これで各シートの内容は元のデータの各行を反映するはず。
VBAを使えば（６）や（７）は自動化できるので、より楽になる。
簡略例
Sheet1の表データ
連番　氏名　住所　以下項目数が多数あっても良い。
１　山田　　調布市
２　鈴木　　千葉市
３　田中　　横浜市
ーー
Sheet2以下の
各シートのフォーマット
　　社員カード　　連番　ZZZ(G1セルと仮定）
氏名　　XXXX
住所　　YYYY
XXXXのセルの式　=VLOOKUP($G$1,Sheet1!$A$1:$C$300,2,FALSE)
yyyyのセルの式　=VLOOKUP($G$1,Sheet1!$A$1:$C$300,3,FALSE)
例では氏名、住所だけに簡略化したが、項目の数だけ式をセットすることになる。!$A$1:$C$300の部分は変わるが。
シート名を各氏名にするのは関数では絶対できない。
VBAが必要
ーー
本質問は初心者には難しい問題である。

お礼

素早い回答をいただき、ありがとうございました。
ご指摘の通り、VBAは初心者以前です。
印刷や画面表示のためではなく、作業用に分割した300シートが必要だったので、質問させていただきました。
imogasiさんの回答は、私には難しかったです。
ありがとうございました。

回答No.2

zap35

以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

ただシートを追加したのではシート名がわかりにくいので、１０行目をコメントでなくすれば（行先頭の「'」を削除すれば）元のシートのA列の値をシート名にするようにしました（各行で重複がある場合はエラーになりますのでNG。もし)

Sub Macro2()
Dim orgWs As Worksheet
Dim idx As Long
　　Set orgWs = ActiveSheet
　　Application.ScreenUpdating = False
　　For idx = 1 To Range("A65536").End(xlUp).Row
　　　　Worksheets.Add after:=Sheets(Worksheets.Count)
　　　　orgWs.Rows(idx).Copy
　　　　Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
'　　　　ActiveSheet.Name = orgWs.Cells(idx, "A").Value 'シート名をＡ列の値にする。B列の値にするなら"B"に変更。
　　Next idx
　　orgWs.Activate
　　Application.CutCopyMode = False
　　Application.ScreenUpdating = True
End Sub

なおブック内の最大シート枚数はメモリ容量に依存しますので、質問者さまのPCで３００枚作成できるかは定かではありません。ご承知おきください。

お礼

素早い回答をいただき、ありがとうございました。
こちらの方法でも、バッチリ解決しました。

回答No.1

hal_n

実際にどのような形で顧客データが記述されているのか分かりませんが、仮に以下の通りだったとします。

・１行目は見出し行で、２行目からデータが始まる
・１列目からデータが始まる

以下のコードを標準モジュールに記述し実行してみてください。

Sub DeployToSheets()
　Dim srcSheet As Worksheet
　Dim destSheet As Worksheet
　Dim lastSheet As Worksheet

　Set srcSheet = ActiveSheet
　Set lastSheet = srcSheet

　Dim i As Integer
　Dim j As Integer
　For i = 2 To srcSheet.UsedRange.Rows.Count
　　Set destSheet = Worksheets.Add(after:=lastSheet)

　　'●●●の部分に顧客名の列を記入（Ｃ列なら３）
　　destSheet.Name = srcSheet.Cells(i, ●●●).Value

　　For j = 2 To srcSheet.UsedRange.Columns.Count
　　　destSheet.Cells(j - 1, 1) = srcSheet.Cells(i, j).Value
　　Next

　　Set lastSheet = destSheet
　Next
End Sub

お礼

素早い回答をいただき、ありがとうございました。
教えていただいた方法で、バッチリ解決しました。