こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

EXCEL VBA 社員毎にファイルを分割したい

お世話になります。

実績.xlsというブックがあります。
これは社内の各支店の売上実績を個人別に記述したファイルです。
内容は下記のような感じです。
A列=支店名
B列=担当者名
C列=売上金額

このデータが記述しているシートの端にボタンをつけてクリックすると、B列の担当者別にファイルを分割して、データも担当者毎に分けて(A-C列をそのままコピーでいいです)デスクトップにファイルを保存する、ということは出来るのでしょうか?

ファイル名もA列+B列の支店名+担当者の名称で保存できれば最高です!
どなたかご教授いただけませんでしょうか?

添付図の例ですと6つのファイルが保存されることになります。

環境
Windows7
Excel2013

投稿日時 - 2015-08-04 22:18:17

QNo.9024498

すぐに回答ほしいです

質問者が選んだベストアンサー

sub macro1()
 dim w as worksheet
 dim n as long
 dim r as long
 dim s as string
 dim WSH as variant
 dim myPath as string
 set w = activesheet
 n = worksheets.count

 on error goto errhandle
 for r = 2 to w.range("A65536").end(xlup).row
  s = w.cells(r, "A") & "_" & w.cells(r, "B")
  w.rows(r).copy worksheets(s).range("A65536").end(xlup).offset(1)
 next r
 on error goto 0

 set wsh = createobject("Wscript.Shell")
 mypath = wsh.specialfolders("Desktop") & "\"

 for r = worksheets.count to n + 1 step -1
  worksheets(worksheets.count).copy
  activesheet.columns.autofit
  activeworkbook.saveas filename:=mypath & activesheet.name
  activeworkbook.close false
  application.displayalerts = false
  worksheets(worksheets.count).delete
  application.displayalerts = true
 next r
 w.select
 exit sub

errhandle:
 worksheets.add after:=worksheets(worksheets.count)
 activesheet.name = s
 w.rows(1).copy range("A1")
 resume
end sub

投稿日時 - 2015-08-04 23:09:17

お礼

keithinさん、ご連絡ありがとうございました!

ご連絡が遅くなりまして申し訳ございませんでした。

やりたいことが完璧に出来ました!!
本当にいつもいつもありがとうございます!!
今回も助かりました!

投稿日時 - 2015-08-06 08:50:58

ANo.1

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問