[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『シート名を別ブックで指定フォルダへ保存したい』（さこ）
マクロに詳しくない為、いろいろ調べて下記2つのモジュールを見つけました。
ただ、どちらもドキュメントに保存するモジュールの為
それを指定フォルダに保存するようにしたいです。
その際、1.2.3.4というシート名以外を保存するようにしたいです。
どのように修正したら良いでしょうか？
Sub SheetSave()
Dim i As Integer
Dim wb1 As Workbook
Dim SheetCnt As Integer
Set wb1 = ActiveWorkbook
SheetCnt = wb1.Sheets.Count
For i = 1 To SheetCnt
Workbooks.Add.SaveAs Filename:=wb1.Worksheets(i).Name &".xlsx"wb1.Worksheets(i).Copy before:=Workbooks(wb1.Worksheets(i).Name &".xlsx").
Worksheets(1)
Next i
End Sub
Sub シート分割()
Dim 対象シート As Worksheet
Dim ファイル名 As String
Dim パス名 As String
ファイル名 = ThisWorkbook.Name ファイル名 = Left(ファイル名, Len(ファイル名) - 5) パス名 = ThisWorkbook.Path &"\"&ファイル名 If Dir(パス名, vbDirectory) = ""Then MkDir パス名 End If ChDir パス名 Application.ScreenUpdating = False For Each 対象シート In Worksheets 対象シート.Copy ActiveWorkbook.SaveAs ActiveSheet.Name &".xlsx"Next Application.ScreenUpdating = True Application.Quit ThisWorkbook.Close False End
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
マクロを置いたファイルの 1.2.3.4 以外のシートを新規ファイルにコピーで保存でしょうか。 移動で保存でしょうか（元のファイルからは削除）。
特定のフォルダは固定でしょうか？つど指定でしょうか。
そのあたりで書き方が変わってきます。
ところで 「1.2.3.4」は間がピリオドですけれど、そういう名前のシートですか？ あるいは4つのシート（名前が「1」「2」「3」「4」）でしょうか？ （QS） 2020/12/13(日) 10:13
1.2.3.4以外のシートをコピーで保存したいです。
特定のフォルダは都度指定です。
月ごとにフォルダ作成する為です。
シートはシート名が「1」、「2」、「3」、「4」の4シートあります。
何卒ご教授願います。
（さこ） 2020/12/13(日) 14:02
提示されたコードは分からないなりにも自己検証してみましたか？
投稿時のミスかもしれませんが、必要な改行が抜けているのでどちらも構文エラーになりますよ。
ちなみに前者を整理・修正すると↓のようになります。
Sub SheetSave_修正()
Dim i As Integer
Dim wb1 As Workbook
With ActiveWorkbook
For i = 1 To .Sheets.Count
Workbooks.Add.SaveAs Filename:=.Worksheets(i).Name & ".xlsx"
.Worksheets(i).Copy before:=Workbooks(.Worksheets(i).Name & ".xlsx").Worksheets(1)
Next
End With
End Sub
こちらの場合、新規ブックを先に作ってから、そのブックシートの先頭に目的のシートをコピー挿入しているわけですが、新規ブックを作成したときのシートがそのままになっちゃいますがそれでよいのでしょうか？
また、後者は「Application.Quit」しているのが気になります。
（最終的に自ブックも閉じるので、想定どおりなのかもしれませんが・・・）
私なら↓のように保存した段階で閉じます。
Sub シート分割()
Dim 保存フォルダ As String
Dim 対象シート As Worksheet
With ThisWorkbook
'▼拡張子を除いたフルパスを得る
保存フォルダ = Left(.FullName, InStrRev(.FullName, ".") - 1)
'▼保存用のフォルダが無ければ作成
If Dir(保存フォルダ, vbDirectory) = "" Then MkDir 保存フォルダ
For Each 対象シート In .Worksheets
'▼対象シートを新規ブックにコピー
対象シート.Copy
'▼↑で作成された新規ブックを操作
With Workbooks(Workbooks.Count)
.SaveAs 保存フォルダ & "\" & .Worksheets(1).Name
.Close
End With
Next
End With
End Sub
そして、質問については、対象のシート名などを確認して対象のものでなければ処理しないように条件分岐をすればよいですよね。
（もこな２ ） 2020/12/13(日) 14:40
＞どちらもドキュメントに保存する～指定フォルダに保存するようにしたい
【前者の場合】
～.SaveAs Filename:=wb1.Worksheets(i).Name &".xlsx"
【後者の場合】
ChDir ThisWorkbook.Path &"\"& Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) ～.SaveAs ActiveSheet.Name &".xlsx"
となっていて、いずれも対象フォルダの指定を省略しているため、カレントフォルダに保存する命令になってます。
これは、省略せずに【フォルダも指定】するればよいだけです。
（方法は既に示しているとおりです）
＞1.2.3.4というシート名以外を保存
＞シートはシート名が「1」、「2」、「3」、「4」の4シートあります。
ということは、「1」、「2」、「3」、「4」というシートは保存されて「1.2.3.4」というシートが万が一あれば処理しない（保存しない）という理解でよいのですか？
（もこな２ ） 2020/12/13(日) 15:12
細かい話ですが、「モジュール」ではなく「プロシージャ」 ですね。（知らなくてもなんとでもなりますが） →失礼いたしました。勉強になります。
提示されたコードは分からないなりにも自己検証してみまし たか？ →検証はしたのですが、ドキュメントに保存されることしか理解できず、知識不足で申し訳ありません。
投稿時のミスかもしれませんが、必要な改行が抜けているの でどちらも構文エラーになりますよ。 →失礼いたしました。見つけたプロシージャをそのまま記載してしまいました。
>Sub SheetSave_修正()
こちらの場合、新規ブックを先に作ってから、そのブックシ ートの先頭に目的のシートをコピー挿入しているわけです が、新規ブックを作成したときのシートがそのままになっち ゃいますがそれでよいのでしょうか？ →sheet1というシートが残ることでしょうか？
残ったままでも問題ございません。
また、後者は「Application.Quit」しているのが気になりま す。 →知識不足で申し訳ありません。
どういった影響があるのでしょうか？
以下、ご教授いただいたプロシージャの保存フォルダの部分に
フォルダのパス"\～"のように置き換えればよいということでしょうか？シートも"1","2"～というように置き換えればよろしいでしょうか？
理解不足で申し訳ありませんが
ご教授願います。
Sub シート分割()
Dim 保存フォルダ As String
Dim 対象シート As Worksheet
With ThisWorkbook
'▼拡張子を除いたフルパスを得る
保存フォルダ = Left(.FullName, InStrRev(.FullName, ".") - 1)
'▼保存用のフォルダが無ければ作成
If Dir(保存フォルダ, vbDirectory) = "" Then MkDir 保存フォルダ
For Each 対象シート In .Worksheets
'▼対象シートを新規ブックにコピー
対象シート.Copy
'▼↑で作成された新規ブックを操作
With Workbooks(Workbooks.Count)
.SaveAs 保存フォルダ & "\" & .Worksheets(1).Name
.Close
End With
Next
End With
End Sub
（さこ） 2020/12/13(日) 16:33
＞1.2.3.4というシート名以外を保存
＞シートはシート名が「1」、「2」、「3」、「4」の4シートあります。
ということは、「1」、「2」、「3」、「4」というシートは保存されて「1.2.3.4」というシートが万が一あれば処理しない（保存しない）という理解でよいのですか？
→はい、おっしゃる通りです。
ですので、除外したいシートを指定したいのです。
（さこ） 2020/12/13(日) 16:36
検証できたのであれば気づいてますよね？
Workbooks.Add.SaveAs Filename:=wb1.Worksheets(i).Name &".xlsx"wb1.Worksheets(i).Copy before:=Workbooks(wb1.Worksheets(i).Name &".xlsx").
Worksheets(1)
↓
Workbooks.Add.SaveAs Filename:=wb1.Worksheets(i).Name &".xlsx"
wb1.Worksheets(i).Copy before:=Workbooks(wb1.Worksheets(i).Name &".xlsx").Worksheets(1)
For Each 対象シート In Worksheets
対象シート.Copy
ActiveWorkbook.SaveAs ActiveSheet.Name &".xlsx"Next
↓
For Each 対象シート In Worksheets
対象シート.Copy
ActiveWorkbook.SaveAs ActiveSheet.Name &".xlsx"
Next
＞＞「1.2.3.4」というシートが万が一あれば処理しない（保存しない）
＞→はい、おっしゃる通りです。
ということはこう考えればよいですね。
Sub シート分割()
Dim 保存フォルダ As String
Dim 対象シート As Worksheet
With ThisWorkbook
保存フォルダ = Left(.FullName, InStrRev(.FullName, ".") - 1)
If Dir(保存フォルダ, vbDirectory) = "" Then MkDir 保存フォルダ
For Each 対象シート In .Worksheets
'▼▼▼対象シートの【名前】が「1.2.3.4」以外のときにこの処理をする▼▼▼
対象シート.Copy
With Workbooks(Workbooks.Count)
.SaveAs 保存フォルダ & "\" & .Worksheets(1).Name
.Close
End With
'▲▲▲対象シートの【名前】が「1.2.3.4」以外のときにこの処理をする▲▲▲
Next
End With
End Sub
↑で少し考えてみて下さい。
ヒント：対象シート.Name でシート名を調べることができます。
（もこな２） 2020/12/15(火) 19:14
Sub シート分割()
Dim 保存フォルダ As String
Dim 対象シート As Worksheet
Stop ' ブレークポイントの代わり
With ThisWorkbook
保存フォルダ = Left(.FullName, InStrRev(.FullName, ".") - 1)
If Dir(保存フォルダ, vbDirectory) = "" Then MkDir 保存フォルダ
For Each 対象シート In .Worksheets
If 対象シート.Name <> "1.2.3.4" Then '★もしも、対象シートの【名前】が「1.2.3.4」以外のときは以下の処理をする
対象シート.Copy
With Workbooks(Workbooks.Count)
.SaveAs 保存フォルダ & "\" & .Worksheets(1).Name
.Close
End With
End If '★もしもの話はおしまい
Next
End With
End Sub
（もこな２ ） 2020/12/20(日) 18:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.