エクセルファイルを取引先ごとに分割

質問

1つのエクセルファイルにすべての取引先の情報が入っているファイルが存在するのですが、そのファイルを取引先ごとに自動で分割したいと思っています。
データの並びは以下のようなものです。
Ａ列　　Ｂ列　　Ｃ列
取引先名　取引内容　金額
取引先1　　○○○　　1000
取引先1　　○○○　　1000
取引先2　　○○○　　1000
取引先2　　○○○　　1000
ネットでいろいろ検索し下記までは見つけて実施してみたのですが、このままですと分割したファイルに表題（各列の1行目の部分）をつけることができません。
http://soudan1.biglobe.ne.jp/qa4088700.html
分割したファイルのすべてに表題をつけたいと思い上記の内容を変更してやってみましたが今の自分の力ではうまくいきません。
申し訳ありませんが、表題部をつけてファイルを分割する方法をアドバイスいただけないでしょうか
宜しくお願いいたします。

回答No.2

imogasi

丸投げの質問だが、一応コードの一例を書いておく。
ーー
例データ
取引先名 取引内容 金額
取引先1 ○○○ 1000
取引先1 ○○○ 2000
取引先2 ○○○ 3000
取引先2 ○○○ 4000
取引先2 ○○○ 5000
取引先3 ○○○ 6000
取引先3 ○○○ 7000
取引先5 ○○○ 8000
取引先6 ○○○ 9000
取引先6 ○○○ 10000
ーー
取引先が変わったら１シート追加し、順次下行に貼り付ける。
ーーー
コード
Sub test01()
d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
MsgBox d
m = Worksheets("Sheet1").Cells(2, "A")
sn = Worksheets.Add.Index
Sheets(sn).Name = m
Sheets(sn).Range("A1:C1") = Array("取引先名", "取引内容", "金額")
K = 2 'コピー先の行番号
'--
For i = 2 To d '元シートデータで２行目以下繰り返し
If Worksheets("Sheet1").Cells(i, "A") = m Then '元シートで１行前と取引先が同じなら
Worksheets("Sheet1").Range("A" & i & ":J" & i).Copy Worksheets(sn).Cells(K, "A")
K = K + 1 '次回貼り付け先を１行下へ
Else
sn = Worksheets.Add.Index 'シートを増やし、インデックス番号取得
Sheets(sn).Range("A1:C1") = Array("取引先名", "取引内容", "金額") '見出しを第１行に
K = 2 '第２行目に下記で貼り付け
Worksheets("Sheet1").Range("A" & i & ":J" & i).Copy Worksheets(sn).Cells(K, "A")
K = K + 1
m = Worksheets("Sheet1").Cells(i, "A") '直前取引先を今の取引先にする
Sheets(sn).Name = m
End If
Next i
End Sub
上記例でテスト済み。
ーーー
実際では、変更箇所
Ｓｈｅｅｔ１
Range("A" & i & ":J" & i）のＪ－＞上記はデータがＪ列まで、の意味です。テストデータは３列しかないが、多めにしたもの。
Array("取引先名", ・・－＞実際の項目名で、実際の数だけ、””で囲って追加
Sheets(sn).Range("A1:C1") も項目数にあわせて変える。
ーー
スキルを要する２、３のことを使っている。この処理ロジックも含め、質問者には難しいかもしれないが、当面鵜呑みしかない。

お礼

親切に回答いただきましてありがとうございます。
この方法でやってみましたが、取引先ごとにシートを追加するのではなく、取引先ごとにファイルを作成したいのです。
他の方法を教えいただき無事解決することができましたが、いろいろなやり方があることがわかり大変勉強になりました。