EXCEL VBA 担当者毎にファイル作成

下記の様な作業をVBAで行うのは可能でしょうか。毎月、手作業で困っています。
よろしくお願い致します。

それぞれの1行目には項目名があり、２行目からは下記のデータ（数字と名前）が入っています。
※1行につき、一人のデータとは限りません。

A列には、社員番号
B列には、名前
D列には（販売日の）日付
D列からK列までは、商品名

・上記のようなシートがあり、人（担当者、A列）により１行しかなかったり、50行ある人もあり、ばらばらです。
・それそれの担当者毎に、ファイル(ブック）を作成したいのです。その際には下記の様な名前をつけたいと思います。
※予めテンプレートがありますので、それに値張りする感じです。

例）社員番号_社員名_営業実績.xls
→00001_鈴木太郎_営業実績,xls

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

• ご指摘、ありがとうございます。自分の書き方が誤っていました。
  
  1行につき、一人のデータです。
  なので、A列でフィルターをかければ、その人の営業実績が特定されます。
  ※A列の人が販売した商品毎の数量が、（C列には販売日）D列以降に並ぶイメージです。当然ですが、A列の社員番号は、B列の担当者の社員番号です。
  
  
  本当に申し訳ありません・・

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/04/12 14:56

• ありがとうございます。
  
  ＞この作業を、具体的に～
  ・担当者が商品を販売すると、社員番号と名前と商品毎に数字を入力します。
  ・２社（人）に対して、同日に販売すると2行になりますし、3社（人）であれば３行です。
  ・毎月、月初に先月末締めのデータを各担当者に、確認作業を行わせます。
  ・チェック欄があり、そこにコメントを入れてもらっています。
  
  ＞パソコンの中に作成されたファイルはどうされるのかも知りたいです。
  ・上記のファイルはメールでやりとりを行い、確認作業が終わったファイルは指定フォルダに格納されます。
  ・社内共有ドライブがありますが、そこから直接、担当者が作業するということはありません。
  
  ＞配布用であれば、ＰＤＦなどの方が良いかと思います。
  ・上記のとおり、そのファイルを使用して作業があるので、エクセルで渡したのです。但し、担当長に進捗を見せるので。それはXPSで渡しています。

  No.2の回答に寄せられた補足コメントです。 補足日時：2015/04/12 16:25

• ありがとうございます。
  ほぼ、理想通りです。
  
  これに加えて、罫線と最後の列（L列にチェック１、M列にチェック２）に指定のチェック欄を入れることは可能でしょうか？
  
  何度も申し訳ありません。

  No.4の回答に寄せられた補足コメントです。 補足日時：2015/04/12 20:38

No.5 ベストアンサー 回答者： tom04 回答日時： 2015/04/12 20:59

No.4です。

＞罫線と最後の列（L列にチェック１、M列にチェック２）に指定のチェック欄を入れることは可能でしょうか？

とは　L1に「チェック1」・M1に「チェック2」という項目名が入れば良い！という解釈です。

↓のコードに変更してみてください。

Sub Sample2()
Dim i As Long, lastRow As Long
Dim myPath As String, fN As String
Dim wS As Worksheet, nB As Workbook

myPath = "保存場所のパス" & "\"
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wS = Worksheets(Worksheets.Count)
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
wS.Range("A:A").Sort key1:=wS.Range("A1"), order1:=xlAscending, Header:=xlYes
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
Workbooks.Add
Set nB = Workbooks(Workbooks.Count)
.Range("A1").AutoFilter field:=1, Criteria1:=wS.Cells(i, "A")
Range(.Cells(1, "A"), .Cells(lastRow, "K")).Copy nB.Worksheets("Sheet1").Range("A1")
'//▼　追加
With nB.Worksheets(1)
.Range("L1") = "チェック1"
.Range("M1") = "チェック2"
.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
.Range("A1:M1").HorizontalAlignment = xlCenter
.Columns.AutoFit
End With
'//▲　まで
fN = Format(wS.Cells(i, "A"), "00000") & "_" & nB.Worksheets(1).Range("B2") & _
"_営業実績（" & Format(Date, "m月") & ")" '//敢えて拡張子は省いています　★
nB.SaveAs Filename:=myPath & fN
nB.Close '//ファイルを閉じない場合、この行を消去　★
Next i
.Activate
.AutoFilterMode = False
Application.DisplayAlerts = False
wS.Delete
Application.DisplayAlerts = True
End With
End Sub

コレではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございます！
最高です！

お礼日時：2015/04/12 21:32

No.4 回答者： tom04 回答日時： 2015/04/12 20:19

こんばんは！

＞毎月、手作業で困っています。
というコトですが、フォルダ内に同じファイル名があるとエラーになりますので
余計なお世話かもしれませんが、ファイル名に「○月」を追加するようにしてみました。

元データはSheet1にあるとします
標準モジュールです。

Sub Sample1()
Dim i As Long, lastRow As Long
Dim myPath As String, fN As String
Dim wS As Worksheet, nB As Workbook

myPath = "保存場所のパス" & "\"
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wS = Worksheets(Worksheets.Count)
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
wS.Range("A:A").Sort key1:=wS.Range("A1"), order1:=xlAscending, Header:=xlYes
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
Workbooks.Add
Set nB = Workbooks(Workbooks.Count)
.Range("A1").AutoFilter field:=1, Criteria1:=wS.Cells(i, "A")
Range(.Cells(1, "A"), .Cells(lastRow, "K")).Copy nB.Worksheets("Sheet1").Range("A1")
nB.Worksheets("Sheet1").Columns.AutoFit
fN = Format(wS.Cells(i, "A"), "00000") & "_" & nB.Worksheets(1).Range("B2") & _
"_営業実績（" & Format(Date, "m月") & ")" '//敢えて拡張子は省いています　★
nB.SaveAs Filename:=myPath & fN
nB.Close '//ファイルを閉じない場合、この行を消去　★
Next i
.Activate
.AutoFilterMode = False
Application.DisplayAlerts = False
wS.Delete
Application.DisplayAlerts = True
End With
End Sub

※　ファイル名を付けて保存（ファイルを閉じる）という操作にしていますが、
敢えて拡張子は指定していません。
（ファイル名を付けて保存する時点で、お使いのバージョンの拡張子に設定されるはずなので）

一発で解決！とはいかないと思いますが、
とりあえずはこの程度で・・・m(_ _)m

No.3 回答者： hallo-2007 回答日時： 2015/04/12 17:36

私だったら

１、シートの追加
　　社員データ
　　　Ａ　　　　Ｂ　　　　Ｃ
　　社員番号　名前　メールアドレス
　　データ抽出シート
　　エクセルのアドバンスフィルターを活用
http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vb …
を参考にしてください。
　　メール原稿のシート
　　Ｂ２　氏名
　　Ｂ３　メールアドレス
　　Ｂ４　件名（先月の売上の件
　　Ｂ５　本文（添付ファイルを確認の上、返信してください。
　　Ｂ６　添付ファイルへのパスとファイル名
２、ＶＢＡの準備
　　１、データ抽出のシートへ担当者のデータのみ抽出
　　２、テンプレートを開く
　　３、テンプレートに抽出したデータを入れる。
　　４、テンプレートを上書き保存（この場合、ファイル名は同じ）
　　５、エクセルからＯｕｔＬｏｏｋを操作して
　　　　現行シートに基づき、担当者へメールを送信する。
　　６、１～５を社員データを元に、全ての社員に対して自動で行う。
http://okwave.jp/qa/q1261338.html
に添付ファイルをＯｕｔＬｏｏｋで送信するマクロがありました。
これで、メールを送信する際に間違った添付ファイルなどのミスもなくなると
思います。
不要なファイルは作成せずに済みます。ファイルの管理はＯｕｔＬｏｏｋ上で行えます。

No.2 回答者： hallo-2007 回答日時： 2015/04/12 16:05

しばし、お付き合いしますが。

＞毎月、手作業で困っています。
この作業を、具体的に書いてもらった方が良いと思います。

もうひとつ、パソコンの中に作成されたファイルはどうされるのかも知りたいです。
毎月、フォルダが増えて、50個ものファイルが増えていく事もやめた方が良いと思います。
作成するファイルはエクセルで無ければならないのでしょうか。
配布用であれば、ＰＤＦなどの方が良いかと思います。
もし、配布したエクセルに担当者が何らかの編集を加えて返信されるようであれば別ですが。

No.1 回答者： prius770c 回答日時： 2015/04/12 14:38

そんなに難しそうな内容じゃないのですが、下記の内容が気になります。

＞※1行につき、一人のデータとは限りません。
1行分のデータが特定の社員1名分ならば、社員番号をキーとしてフィルターなどで抽出して、その結果を新しいブックに張り付けて、所定のファイル名にすることになります。

ただし、上記のように1行に複数名のデータが入っている状態では、この方法が、管理方法によっては使えません。
また、そのような管理方法はあまりいい方法とは言えません。

社員番号と社員名の列に複数名の番号や名前が入ってるのかな？？
だとすると、ちょっとその意図が分かりかねますね。