複数シートを別ファイルで保存したい Excel vba マクロ エクセル

こんにちは。
マクロ初心者です。
毎月発生する単純作業をなんとか自動化できないかと考えております。

やりたいのは、60以上あるシートを、いくつかのシートずつコピーして別ファイルに保存することです。
シート名と保存するファイル名は毎回同じです。
例えで書きますが、
①48都道府県の名前のシートがある。
（"愛知"、"三重"、"東京"...）
②地方ごとにシートをコピーして地方名のファイルで保存する。
（"関東"というファイル名で"東京""群馬""千葉""茨城""栃木"シートを保存する）
③その際にファイルにパスワードもかける。

といった操作がしたいです。
（実際は、行政区ごとのデータシートを管轄営業所ごとに分けて保存したい。）

大変お手数をお掛けしますが、お知恵を貸していただけたら嬉しいです。
シート名などを書き換えたらそのまま使えるようなコードを書いていただけると、本当に助かります。

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

• 説明不足で申し訳ありません。
  そもそもシートを分割しているのは私です。
  全国のデータがひとつのシートになっているものが元々あり、それを各事業所に、行政区ごとのシートに切り分けて、シートを何枚かまとめたファイルを送らなくてはいけません。
  シート分割はマクロでやってますが、その後の各ファイルへの分割が手間なので、困っています。

    補足日時：2018/11/17 04:03

• ありがとうございます！
  これでできたら最高なのですが、どうやったらできるかもう少し詳細に教えていただくことは可能でしょうか(>_<)

  No.3の回答に寄せられた補足コメントです。 補足日時：2018/11/20 00:36

No.4 ベストアンサー 回答者： tatsu99 回答日時： 2018/11/20 09:54

以下のマクロを標準モジュールに登録してください。

配置はNO3の添付図の通りです。
パスワードは"abcd"にしています。
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & bname & ".xlsx", Password:="abcd"
の箇所の"abcd"を適切な文字に設定して下さい。
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
Option Explicit
Public Sub 管轄営業所ブック作成()
Dim maxrow As Long
Dim wrow As Long
Dim ks As Worksheet
Dim sname As String
Dim bname As String
Dim prev_bname As String
Dim wb As Workbook
Dim dicT As Object
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set ks = Worksheets("管理")
maxrow = ks.Cells(Rows.Count, "A").End(xlUp).Row
'ブックの連続チェック及びシート名の存在チェック
prev_bname = ""
For wrow = 2 To maxrow
bname = ks.Cells(wrow, "A").Value
sname = ks.Cells(wrow, "B").Value
If prev_bname <> bname Then
If dicT.exists(bname) = True Then
MsgBox ("ブック名:" & bname & "は連続していません")
Exit Sub
End If
dicT(bname) = True
End If
If CheckSheet(sname) = False Then
MsgBox ("シート名:" & sname & "は存在しません")
Exit Sub
End If
prev_bname = bname
Next
Application.ScreenUpdating = False
'ブックの作成
prev_bname = ""
For wrow = 2 To maxrow
bname = ks.Cells(wrow, "A").Value
sname = ks.Cells(wrow, "B").Value
If prev_bname <> bname Then
Call CloseBook(wb, prev_bname)
Set wb = Workbooks.Add(xlWBATWorksheet)
End If
ThisWorkbook.Worksheets(sname).Copy after:=wb.Worksheets(wb.Worksheets.Count)
prev_bname = bname
Next
Call CloseBook(wb, prev_bname)
Application.ScreenUpdating = True
MsgBox ("完了")
End Sub
'ファイルの保存
Private Sub CloseBook(ByVal wb As Workbook, ByVal bname As String)
If bname = "" Then Exit Sub
Application.DisplayAlerts = False
wb.Worksheets(1).Delete
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & bname & ".xlsx", Password:="abcd"
Application.DisplayAlerts = False
wb.Close
End Sub

'シートの存在チェック
Private Function CheckSheet(ByVal sname As String) As Boolean
Dim ws As Worksheet
On Error GoTo ERROR99
Set ws = Worksheets(sname)
CheckSheet = True
Exit Function
ERROR99:
CheckSheet = False
End Function

この回答へのお礼

ありがとうございます！
まず試しにマクロをコピペさせていただいたファイルはこれで完璧に作動しました。
本当に感謝です。

ちなみに、こちらのファイルを開いたままで、前週作業分の別のファイルに「管理」シートをコピーして、マクロを作動させたら「インデックスが有効範囲にありません」となり、
ThisWorkbook.Worksheets(sname).Copy after：=wb.Worksheets（wb.Worksheets.Count）

のところでエラーが出てしまいました。
これは、毎回新しい作業用ファイルにマクロをコピペしないと作動しないということでしょうか？？

お礼日時：2018/11/20 11:13

No.5 回答者： tatsu99 回答日時： 2018/11/20 11:50

＞これは、毎回新しい作業用ファイルにマクロをコピペしないと作動しないということでしょうか？？

はい。その通りです。
No3の確認事項の条件３を参照ください。
３．マクロは、シート名：管理を持つブック内に記述すること。
となっています。

この回答へのお礼

ありがとうございます！
マクロを記載したファイルに、大元のシートのほうをコピーしてこれば良いことに気づきました。
すみません(>_<)

最後に、シートの存在チェック、だけどんな作業をしているのかわからず、教えていただけないでしょうか。

お礼日時：2018/11/20 13:03

No.3 回答者： tatsu99 回答日時： 2018/11/17 23:51

添付図のような管理シートを作成し、A列に出力するブック名、B列に出力ブックへ格納するシート名を記入するのはいかがでしょうか。

条件としては
１．シート名：管理　に記入すること。及びこのブック内にコピー元のシートが全て存在すること。
２．同じ出力ブック名は、連続していること。
３．マクロは、シート名：管理を持つブック内に記述すること。
４．出力ブックの出力先フォルダは、シート名：管理を持つブックと同じフォルダとなる。
５．出力ブックの拡張子は".xlsx"となる。
６．パスワードは、全ての出力ブックに同じ値が設定される。

上記の条件で良ければ、作成可能です。
添付の例では、以下のブックが作成されます。（）内は格納されるシート名
関東.xlsx（東京、神奈川、千葉）
関西.xlsx（大阪、兵庫）
九州.xlsx（大分、鹿児島）

この回答へのお礼

ごめんなさい、初めての質問で仕組みがわかっておらず、補足と重複してしまいますが...

まさにこれがやりたいことなのですが、どのようなコードを書けばよいか、詳しく教えて頂くことは可能でしょうか。

お忙しいところ恐れ入りますが、どうぞよろしくお願いいたします。

お礼日時：2018/11/20 09:50

No.2 回答者： googoo900 回答日時： 2018/11/16 23:20

>やりたいのは、60以上あるシートを、いくつかのシートずつコピーして別ファイルに保存することです。

元ファイルを作成している人(部署)に、分割して作ってもらうように依頼するのがよいと思います。
現状の効率の悪いやり方を正して、会社として効率化に取り組むべきです。

No.1 回答者： かわごえ 回答日時： 2018/11/16 17:26

別ファイルに保存するくらいなら最初から分けられないワークフローなんですかね

めんどくさいので元ファイルから読み込みするだけ、リンクしてるだけのブックを作成するんじゃダメですかね
ファイル名を地方名を指定すれば勝手に読み込んでくるとか