【VBA】ファイル名の保存について

Question

前提・実現したいこと

ファイル名を保存するのをセルに示されている日付にしたいです．

ActiveWorkbook.SaveAs "C:\Work\ " & Format(ws.Range("A4"), "yyyy\年mm\月dd\日") & ".xlsx"
の部分で下記のようなエラーが生じされます．
解決策をご教授頂きたいです．

発生している問題・エラーメッセージ

実行時エラー9
インデックスが有効範囲にありません vba

Sub データ整理()

Dim i As Long
i = 1

Do Until i > 3

Dim j As Long
j = 4 + (i - 1) * 144
Dim k As Long
k = 147 + (i - 1) * 144

'//1日ごとのデータコピー
ThisWorkbook.Activate
Range(Cells(1, 1).Address & ":" & Cells(3, 28).Address & "," & Cells(j, 1).Address & ":" & Cells(k, 28).Address).Select
Application.CutCopyMode = False
Selection.Copy
'//新しいブックを製作
Set wk = Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'//日付と時刻の修正
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormatLocal = "yyyy/m/d"
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormatLocal = "h:mm;@"
Range("A4").Select
Application.CutCopyMode = False

'//名前を付けて保存
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("C:\Work") Then .CreateFolder "C:\Work"
End With
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ActiveWorkbook.SaveAs "C:\Work\ " & Format(ws.Range("A4"), "yyyy\年mm\月dd\日") & ".xlsx"←ここでエラー
ActiveWorkbook.Close

    i = i + 1
    
Loop

End Sub

ソースコード

試したこと

なぜか一度だけうまくいきました．けど2回目以降エラーが生じました．

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Comments

[otn]

> 【VBA】ファイル名の保存について
どこに保存するのだろうと思ったら、日本語が間違ってますね。
「保存するファイル名について」の間違いのようですね。

Answer 1

Format関数を修正してみました。

ActiveWorkbook.SaveAs "C:\Work\" & Format(ws.Range("A4").Value, "yyyy年mm月dd日")  & ".xlsx"
'ActiveWorkbook.SaveAs "C:\Work\ " & Format(ws.Range("A4"), "yyyy\年mm\月dd\日") & ".xlsx"

Comments

[g20tm016]

回答ありがとうございます。すみません，コードを変更しても同様のエラーが表示されます，，

[TanakaHiroaki]

そうですか。
ws.Range("A4").Value や Format(ws.Range("A4").Value, "yyyy年mm月dd日")
の値を確認してみてください。

[g20tm016]

ご返信ありがとうございます。値を確認したのですが、A4のセルには日付があり問題ないと思われます。

[TanakaHiroaki]

ステップイン実行し、イミディエイトウィンドウでDebug.Printで確認してみてください。
Debug.Print ws.Range("A4").Value

[g20tm016]

ステップインを実行した結果,Set ws = Sheets("Sheet1")で上記のようなエラーが確認できました。こちらの不手際で申し訳ないのですが、どこに問題があるかわからなくなってしまいました。何かアドバイスいただけますと幸いです。

Answer 2

どちらが正しいかはわかりませんが、以下のいずれかにしてみてはいかがでしょうか。

  Set ws = ThisWorkbook.Sheets("Sheet1")  
  Set ws = wk.Sheets("Sheet1")

Comments

[g20tm016]

助かりました．本当にありがとうございます