🎄

新規に作成したワークブックに既存ファイルのシートをコピーするマクロ

2024/12/19に公開

はじめに

新規に作成したワークブックに既存ファイルのシートをコピーするマクロを作り、Excelデータの抽出処理を実行しました

実装したソースコード

実装したソースコードは以下の通りです。
(テストのソースコードのため関数、変数名が「リーダブルコード」に記載のルールに従ってませんのでご了承ください)

'新しいExcelファイルにシートごとコピー
Sub test2()
    'ワークブックのオブジェクト変数定義
    Dim wb1, wb2 As Workbook
    'ワークシートのオブジェクト変数定義
    Dim ws1, ws2 As Worksheet
    'ファイル名、パス、フルパスの変数定義
    Dim file_name As String
    Dim full_path As String
    Dim full_path_file As String
    'コピー後のファイル名
    Dim add_file_name As String
    add_file_name = "作業用_"
    Dim full_path_add_file As String
    
    'フルパスの取得
    full_path = ActiveWorkbook.Path & "\"
    'ファイル名の取得
    file_name = Dir(full_path & "F*.xlsx")
    'フルパスのFではじまるファイルの変数定義
    full_path_file = full_path & file_name
        
    'コピー先ファイルを取得
    full_path_add_file = full_path & add_file_name & file_name
    
        
    'ワークブックオブジェクトをセット
    Set wb1 = Workbooks.Open(full_path_file)
    Set ws1 = wb1.Worksheets(1)
    '新しいワークブックを作成する
    Set wb2 = Workbooks.Add
    '新規作成のワークブックの、1番前にシートを挿入
    ws1.Copy Before:=wb2.Sheets(1)
    '新規作成の際にできるワークシートを削除する
    wb2.Sheets(wb2.Sheets.Count).Delete
    '新規に作成したワークブックを名前を指定して保存
    wb2.SaveAs Filename:=full_path_add_file, FileFormat:=xlOpenXMLWorkbook
    '新規に作成したワークブックを閉じる
    wb2.Close SaveChanges:=False
End Sub

最後に

意外とすんなり実装できました。

Discussion