プロが教える店舗&オフィスのセキュリティ対策術

現在のExcelのセルにある数字(例;C5 「2023」)を拾って、Excelファイル名に付与して、新しいファイルとして、保存するマクロを教えてください。

1. 現在のExcelファイル、「決算書2022」があります。
2. このうち、写真のように、セルC5にある「2023」の数字を拾って、「2022」と入れ替えて、新しいファイル「決算書2023」を作成して保存をします。
3. 旧ファイル「決算書2022」と新ファイル「決算書2023」がともに、フォルダーに残ります。
4. 上記No.2の処理の前に、条件式で、もし、C4=C5ならば、「年度が同じなので、繰越できませんでした」とのメッセージを表示して、マクロは終了します。
5. もし、C4=C5でなければ、上記No.2の処理をして、「知年度の繰越が完了しました」と表示して。マクロは終了します。

なお、セルC5:「2023」は、C5=YEAR(TODAY()) により、現在の年度を表示しています。
よろしくお願いいたします。

「Excelのマクロについてご教授ください」の質問画像

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

  • kamerabeginner様
    恐縮ですが、更にご教示をいただけないっでしょうか。
    ご提案のマクロをExcelにコピペして、xlsm形式で保存して、最初うまく行きましたが、C4をC5の値に更新する処理を挿入して何回か試しているうちに、「決算書2023.xlsm」ファイル自体が作成されなくなってしまいましたが、もし、原因がお分かりになりましたら、ご教示いただけますでしょうか。
    なお、完了メッセージは、写真のように表示されて。正常終了しております。

    「Excelのマクロについてご教授ください」の補足画像1
    No.1の回答に寄せられた補足コメントです。 補足日時:2023/02/25 20:18
  • kantansi様

    ご教示いただきましたコードをコピペにより、Excelに実装しましたが、No.1の方への補足と同じく、「新年度の繰越が完了しました」のメッセージがでますが、ファイルができていません。ファイルパスは、パスのコピーで取得してありますので、間違いないと思いますが、原因はどのようなことが考えられますでしょうか。よろしくお願いいたします。

    No.2の回答に寄せられた補足コメントです。 補足日時:2023/02/25 21:42

A 回答 (2件)

Sub CreateNewFile()



' 現在のExcelファイル名を取得
Dim CurrentFileName As String
CurrentFileName = ActiveWorkbook.Name

' セルC4とC5を比較し、年度が同じ場合はメッセージを表示して終了
If Range("C4").Value = Range("C5").Value Then
MsgBox "年度が同じなので、繰越できませんでした"
Exit Sub
End If

' 新しいファイル名を作成
Dim NewFileName As String
NewFileName = Left(CurrentFileName, Len(CurrentFileName) - 8) & Range("C5").Value & ".xlsx"

' 新しいファイルを作成して保存
ActiveWorkbook.SaveCopyAs NewFileName

' メッセージを表示して終了
MsgBox "新年度の繰越が完了しました"

End Sub
この回答への補足あり
    • good
    • 1
この回答へのお礼

早速、ご教授ありがとうございます。
今時間がないために、午後に試行してみますの暫くお待ちください。

お礼日時:2023/02/25 11:35

以下は、要件に基づいたExcelマクロの例です。

実行前に必要に応じてファイルパスなどを適宜変更してください。

VBネット
Copy code
Sub SaveNewFile()
Dim currYear As String, newYear As String, currFileName As String, newFileName As String, folderPath As String
currYear = Range("C4").Value
newYear = Range("C5").Value
currFileName = ActiveWorkbook.Name
folderPath = "C:\Users\UserName\Documents\Excel Files\" ' フォルダーパスを適宜変更
If currYear = newYear Then
MsgBox "年度が同じため、繰越できませんでした。", vbInformation, "処理終了"
Exit Sub
Else
newFileName = Left(currFileName, Len(currFileName) - 8) & newYear & ".xlsx"
ActiveWorkbook.SaveCopyAs folderPath & newFileName
MsgBox "新年度の繰越が完了しました。", vbInformation, "処理終了"
End If
End Sub
注意事項:

ファイルの保存場所 (folderPath) は必ず変更してください。
フォルダーパスには、フォルダー名の間にバックスラッシュ () を使用してください。
実行前に、必ず旧ファイルを保存してください。
この回答への補足あり
    • good
    • 1
この回答へのお礼

早速、ご教授ありがとうございます。
今時間がないために、午後に試行してみますの暫くお待ちください。

お礼日時:2023/02/25 11:36

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!