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

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

No	項目	内容
1	AAAAAAAAA	aaaaaaaaaaaaaaaaaaa
2	BBBBBBBBB	bbbbbbbbbbbbbb
3	CCCCCCCCCC	ccccccccccc
4	DDDDDDDDD	dddddddddddddddddddddd
5	EEEEEEE	eeee
6
7
8

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

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

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

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ファイルを別ファイルにコピーする例

いいね:

コメント

共有:

いいね:

コメント