【VBA】現在開いてるExcelファイルを別ファイルにコピーする例

VBA・Officeカテゴリを表すパンダのイラスト VBA・Office

Excelで作成されたよくある一覧表形式のファイル

No項目内容
1AAAAAAAAAaaaaaaaaaaaaaaaaaaa
2BBBBBBBBBbbbbbbbbbbbbbb
3CCCCCCCCCCccccccccccc
4DDDDDDDDDdddddddddddddddddddddd
5EEEEEEEeeee
6
7
8

このファイル自身を、バックアップのために、例えば以下のルール名で保存したい

YYYYMMDDNNNN_ファイル名
YYYYMMDD:日付
NNNN:一覧表のインデックスNo

そのような場合に使えるVBAコード

ポイントは、ThisWorkbook.SaveCopyAs を使うこと

Option Explicit

Sub CopyMySelf()

    Dim Path As String
    Dim Ws As Worksheet
    Set Ws = ThisWorkbook.Sheets("Sheet1")
    
    Path = GetSaveFilePath
    Path = Path & GetTargetDay
    Path = Path & GetLastLastRowIndex(Ws, 3) '最終行からNoを検索
    Path = Path & GetFileName
    
    Dim InformationPrompt As String
    InformationPrompt = InformationPrompt & "ツールが自動生成したファイル名です。" & vbLf
    InformationPrompt = InformationPrompt & "YYYYMMDD:" & GetTargetDay & vbLf
    InformationPrompt = InformationPrompt & vbLf
    InformationPrompt = InformationPrompt & "このファイル名で保存しますか?" & vbLf
    
    Path = InputBox(InformationPrompt, "出力先ファイルパス", Path)
    ThisWorkbook.SaveCopyAs Path

End Sub

Function GetLastLastRowIndex(ByVal Ws As Worksheet, ByVal CheckColmun As Long)
    Dim LastRowIndex As Long
    LastRowIndex = Ws.Cells(Rows.Count, CheckColmun).End(xlUp).Row
    GetLastLastRowIndex = Format(LastRowIndex, "0000")
End Function

Function GetTargetDay()
    GetTargetDay = Format(Now, "YYYYMMDD")
End Function

Function GetFileName()
    GetFileName = "_" & ThisWorkbook.Name
End Function

Function GetSaveFilePath()
    GetSaveFilePath = ThisWorkbook.Path & "\Tmp\"
End Function


文書情報

記事タイトル
【VBA】現在開いてるExcelファイルを別ファイルにコピーする例
作成日
更新日
Source URL
https://papanda925.com/?p=1896

ライセンス: 本記事のうち、当サイトが権利を有する本文・自作図表は、特記なき限り CC BY 4.0 で利用できます。生成AIを活用して作成・編集した内容を含みます。コードについて、別途ライセンス表示またはリンク先GitHubリポジトリのライセンスがある場合は、その条件を優先します。引用・第三者資料・画像・商標等は本ライセンスの対象外です。 利用ポリシー

タイトルとURLをコピーしました