『Excelシートの保存』（SEL）
Excelで固定のsheet（例えば チェック１，チェック２という名前の固定シート）だけを新規bookにコピーして、
CTrl＋shift＋アルファベットをクリックすると
（C）ローカルの所定のフォルダに保存する記述を教えてください。
シートを抜き出さなくても bookごと保存して
不要なシート（４シートくらいあります）を削除してもよいです。
宜しくお願い致します。
＜ 使用 Excel：Excel2019、使用 OS：Windows11 ＞
Sub sample()
Const SAVE_DIR = "C:\FolderName"
Dim wb As Workbook : Set wb = Workbooks.Add
Dim sh As Worksheet
For Each sh in ThisWorkbook.Sheets("チェック1","チェック2")
sh.Copy After:= wb.Sheets(wb.Sheets.Count)
Next sh
Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True
wb.SaveAs SAVE_DIR & "チェックシート" & "_“ & Format(Date, "mmdd") & ".xlsx"
End Sub
（FL） 2025/06/03(火) 14:53:00
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name = "チェック1" Or sh.Name = "チェック2" Then
sh.Copy After:=wb.Sheets(wb.Sheets.Count)
End If
Next sh
（FL） 2025/06/03(火) 14:56:26
（梅雨入り） 2025/06/03(火) 14:59:24
> ↑ なんなんこれ？ マクロのショートカットキーかと （FL） 2025/06/03(火) 15:02:53
正当と書いていただく前に記載いただいた中に、
wb.SaveAs SAVE_DIR & "チェックシート" & "_“ & Format(Date, "mmdd") & ".xlsx" と記載いただきましたが シートコピーして新たなbookを （C）ローカルの 実績フォルダに
所定の名前を付けて保存したく、
ファイル名は 実績＆当日の日付と時間にしたいです。
重ね重ね申し訳ないですがご教示ください。
※マクロのショートカットキーは忘れて下さい、、（失礼しました）
（SEL） 2025/06/03(火) 15:22:07
Const SAVE_DIR = "C:\実績\" と変更
wb.SaveAs SAVE_DIR & "実績" & "_“ & Format(Now, "yymmdd_hhmm") & ".xlsx" と変更
です。 （FL） 2025/06/03(火) 15:48:42
For Each sh in ThisWorkbook.Sheets("チェック1","チェック2")
原因おわかりになりますでしょうか。
宜しくお願い致します。
（SEL） 2025/06/03(火) 17:25:27
失礼しました。こちらの方が正当かも
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name = "チェック1" Or sh.Name = "チェック2" Then
sh.Copy After:=wb.Sheets(wb.Sheets.Count)
End If
Next sh
こちらご確認ください。 （FL） 2025/06/03(火) 17:27:09
下記でもいいかと。
Sub Sample()
Const SaveFolder = "C:\実績\"
Sheets(Array("チェック1", "チェック2")).Copy
ActiveWorkbook.SaveAs SaveFolder & "実績" & "_" & Format(Now, "yymmdd_hhmm") & ".xlsx"
End Sub
（hatena） 2025/06/03(火) 17:54:27
解説しておきます。
複数シートをまとめて操作するときは、Sheets(Array("チェック1", "チェック2")) というようにはArray関数で配列にする。
Copyメソッドでコピー先ブック名を省略すると新規ブックにコピーされる。
Copyメソッドの実行後はコピー先ブック(新規ブック)がアクティブになっている。 （hatena） 2025/06/03(火) 18:00:50
追加したいのが、
?@保存しましたのメッセージを出す
?A保存したファイルは閉じる ですがうまくいきません。（元のツールが閉じてしまう、メッセージが出ない）
添削いただけないでしょうか。
Const SAVE_DIR = "C:\実績\"
Dim wb As Workbook: Set wb = Workbooks.Add
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name = "チェック1" Or sh.Name = "チェックシ2" Then
sh.Copy After:=wb.Sheets(wb.Sheets.Count)
End If
Next sh
wb.SaveAs SAVE_DIR & "実績" & "_" & Format(Now, "yymmdd_hhmm") & ".xlsx"
ThisWorkbook.Close
MsgBox "実績に保存しました"
End Sub
（SEL） 2025/06/03(火) 18:04:29
追加したいのが、から文字化けしました。失礼しました。
１．保存しましたのメッセージを出す
２．保存したファイルは閉じる ですがうまくいきません。
（元のツールが閉じてしまう、メッセージが出ない）
（SEL） 2025/06/03(火) 18:05:59
ThisWorkbook.Close →wb.Close False に変更
MsgBoxはそのままです。
"実績" & "_" →"実績_" でよかったです。 （FL） 2025/06/03(火) 18:14:46
１．保存しましたのメッセージを出す ←出ました！
２．保存したファイルは閉じる ←閉じました！
Cの実績に保存したファイルを開くと
チェック２のシートが開くので、最初のシート（チェック１）を開くことは可能でしょうか。
また、仕方ないのかもしれませんが、
sheet1 が勝手に作られます（←それ自体は問題ないのですが・・・）
（SEL） 2025/06/03(火) 18:33:51
＞ １．保存しましたのメッセージを出す ＞ ２．保存したファイルは閉じる
Sub Sample()
Const SaveFolder = "C:\実績\"
Sheets(Array("チェック1", "チェック2")).Copy
With ActiveWorkbook
.SaveAs SaveFolder & "実績_" & Format(Now, "yymmdd_hhmm") & ".xlsx"
.Close
End With
MsgBox "実績に保存しました"
End Sub
これで、 保存した実績ファイルを開くと チェック1 がアクティブになってます。 sheet1は作られません。
（hatena） 2025/06/03(火) 20:47:18
Application.DisplayAlerts = False wb.Sheets(1).Delete Application.DisplayAlerts = True
この3行記述してないからですね （FL） 2025/06/03(火) 20:49:21
ちなみに、hatenaさんの回答が最もわかりやすいかと。 マクロの記録に沿ったような記述をするとそうなります。
わざわざ新しいブックを作成してそちらにコピーしているのは ActiveやSelectをベースにコードを記述する癖がつくと 異なる環境で正常に動作しないマクロが乱立することになるので 無意識的に避けているだけです。 ※シートのインデックスが変わること考慮してねーじゃんというツッコミはご愛嬌で。 （FL） 2025/06/03(火) 21:09:17
厚かましいですが、もう１つありまして、
チェック１，チェック２シートはピボットで、その元となるデータを開く作業が手前にあるのですが、
対象のファイルを開く →ファイルを開いたときにもし違うファイルを開いてしまったときの
分岐を作りたいです。
2つのファイルの違いは、ファイル名の冒頭が”実績・・・”か”売上・・・”とそれぞれ固定です。
実績のファイルを設定するはずが、売上のファイルを設定したときに、ファイルが違います。と
分岐したいのですが ご教示いただけませんか。
途中まで記載します↓
MsgBox ("実績ファイルを開いてください")
Dim OpenFileName As String Dim macroBook As Workbook Set macroBook = ActiveWorkbook
Sheets("実績").Select
Range("B2:AM1000").Select
Selection.ClearContents
OpenFileName = Application.GetOpenFilename("実績,*.xls?")
If OpenFileName <> "False" Then
Set Wb1 = Workbooks.Open(OpenFileName)
Else
MsgBox "ファイルが間違っています"
End If ・・・・ ここで脳が停止しました。
（SEL） 2025/06/04(水) 08:52:43
FLさん > ActiveやSelectをベースにコードを記述する癖がつくと > 異なる環境で正常に動作しないマクロが乱立することになるので > 無意識的に避けているだけです。
重要な指摘だと思います。 ActiveやSelectはなるべく使わない。 Activeなオブジェクトを対象にするのを前提のコードは避ける。 というのは私も意識しています。
AddメソッドのようにCopyメソッドもブックオブジェクトを返すという仕様なら、 Set wb = Workbooks.Copy というような記述ができるのですが、残念ながらそのような仕様ではないです。 仕方ないので対策として、 Copyメソッドの直後にオブジェクト変数にActiveWorkbookを代入する あるいは、上記の私のコードのようにWithステートメントで有効範囲を 明確にする というように意識してコーディングしてます。
このような観点から、SELさんの前記のコード
Sheets("実績").Select
Range("B2:AM1000").Select
Selection.ClearContents
はあまりよろしくないですね。下記のようなコードにするように意識しましょう。
ThisWorkbook.Sheets("実績").Range("B2:AM1000").ClearContents
で、本題ですが、
> 実績のファイルを設定するはずが、売上のファイルを設定したときに、ファイルが違います。と > 分岐したいのですが ご教示いただけませんか。
ファイルが違っていた場合、分岐してどうしたいのでしょうか。 それを明確にしましょう。
違っていたら、 「違うよ」とメッセージを表示して以降の処理を中止する のか、 「違うよ」とメッセージを表示して再度ファイル選択ダイアログを表示する 正しいファイルを選択するまで繰り返す とするのか、 （hatena） 2025/06/04(水) 13:37:20
＞下記のようなコードにするように意識しましょう。
ThisWorkbook.Sheets("実績").Range("B2:AM1000").ClearContents
ファイルが違っていた場合の分岐ですが、
「違うよ」の後は、
「もう一度ファイルを選択してください」とメッセージを出して はい（YES）だとファイルを選び直す（プロパティ表示）、 いいえ（NO）は 処理を終了します。コメントがよいです。
正しいファイルを選択し続けるまで連続してもよいと思いましたが、ツールに不慣れな人が使うこともあるので いいえを選択した場合は、最初から設定し直しの方がわかりやすいかと思いました。
宜しくお願い致します。
※そのあと、開いたファイルの A2:AMセルの一番下のセル（変動）をコピーして、
実績シートのA2から貼りつける
そのあと、A〜AV列を選択して 項目を並び替える処理がつづきます。
（SEL） 2025/06/04(水) 14:03:12
一例をあげると下記のようなコードになります。
Do
OpenFileName = Application.GetOpenFilename("実績,*.xls?")
If OpenFileName = "False" Then
MsgBox "キャンセルされました"
Exit Sub
ElseIf Dir(OpenFileName) Like "実績*" Then
Set Wb1 = Workbooks.Open(OpenFileName)
Exit Do
Else
If MsgBox("ファイルが間違っています。もう一度ファイルを選択してください。", vbOKCancel) <> vbOK Then
Exit Sub
End If
End If
Loop
下記のような仕様になります。
ファイル選択ダイアログで[キャンセル]を押したら処理中止
正しいファイル("実績"で始まる)を選択したら次の処理へ
間違ったファイルを選択したら
「もう一度ファイルを選択してください。」([OK],[キャンセル])とメッセージを表示して
OKならDoループの先頭から繰り返す
キャンセルなら処理中止
（hatena） 2025/06/04(水) 15:32:09
MsgBox ("実績ファイルを開いてください")
Dim OpenFileName As String Dim macroBook As Workbook Set macroBook = ActiveWorkbook
ThisWorkbook.Sheets("実績").Range("B2:AM1000").ClearContents
Do
OpenFileName = Application.GetOpenFilename("実績,*.xls?")
If OpenFileName = "False" Then
MsgBox "キャンセルされました"
Exit Sub
ElseIf Dir(OpenFileName) Like "実績*" Then
Set Wb1 = Workbooks.Open(OpenFileName)
Exit Do
Else
If MsgBox("ファイルが間違っています。もう一度ファイルを選択してください。", vbOKCancel) <> vbOK Then
Exit Sub
End If
End If
Loop
Range("A2:AM1000").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=2
Selection.Copy
macroBook.Activate
Sheets("実績").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'更新日付（AG列早い時間）順に並び替え
※この後実績シートをピボットにするので、ピボットで更新日時を並べ替えすればよいとも思い
その場合は以下消します。
Sheets("実績").Select
Range("A1:AV14").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("実績").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("実績").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("AG2:AG200"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("実績").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("表紙").Select
MsgBox "完了しました"
（SEL） 2025/06/05(木) 08:48:59
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.