🎄
新規に作成したワークブックに既存ファイルのシートをコピーするマクロ
はじめに
新規に作成したワークブックに既存ファイルのシートをコピーするマクロを作り、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