子ブック生成マクロ
親ブックから子ブックを生成する方法
先日、コチラの記事をうｐしたところ、twitterのフォロワーさんから、
FileCopyステートメントでよくね？？？
的なリプをいただいたのだった。
私自身、
たかがブックの複製を作るぐらいのことでシートを１つ１つコピーした後余分なシートを削除していく
などというやり方は迂遠に過ぎると思っていたところだったので、使ったことなかったけど、FileCopyステートメントとやらを使ってみることにした。
準備
まずは、
こんな親ブックを用意した。
やりたい処理は、
- 「データ」シートＢ列にあるデータ（笑）を「個別」シートのＡ１セルに転記する
- Ａ１セルにデータが書き込まれたブックを「子ブック」として別のフォルダに保存する
というもの。
最終的には、親ブックの「データ」シートにあるＢ列のデータ（笑）を１つづつ転記しては子ブックとして保存、という風にするのだけれど、とりあえず今回は
１つ目のデータ（「アホ」）を転記した子ブックを保存する
だけにしておく。
処理の手順
次のように考えた。
- FileCopyステートメントで親ブックのコピーを別フォルダに作る。
- 新しくできた子ブックを開く。
- データ（笑）を転記する。
- 子ブックを保存して閉じる。
コーディング
次のようにコードを書いた。
リスト１
Option Explicit
Public Sub createChildWorkbook()
Dim originalWorkbook As Workbook
Set originalWorkbook = ThisWorkbook
Dim folderPath As String
folderPath = originalWorkbook.Path & "\収容所\" '"
If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath)
FileCopy originalWorkbook.FullName, folderPath & "子ブック" '……(*)'
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Open(folderPath & "子ブック.xlsm")
newWorkbook.Worksheets("個別").Range("A1").Value = _
originalWorkbook.Worksheets("元データ").Range("B2").Value
Application.DisplayAlerts = False
newWorkbook.Worksheets("元データ").Delete
newWorkbook.Close True
Set newWorkbook = Nothing
Application.DisplayAlerts = True
End Sub
実行
上記のコードを実行すると、
あっさり一蹴ｗｗｗ
(*)のところでエラーが出ていた。
ちょいとggってみると、コチラのブログがヒット。
それによると、
ExcelのVBAでファイルをコピーする際に使用する"FileCopy"は開かれているファイルをコピーすることはできません。
とのこと。
で、
コピー元ファイルが閉じている(使用されていない)ことを保証できない場合は、ExcelのVBAの"FileCopy"を使用せずに"Scripting.FileSystemObject"の"CopyFile" を使用します。
ということ。なるほど、FileSystemObjectオブジェクトのCopyFileメソッドを使えばいいわけか。
コードの修正
次のように修正。ちなみに、CreateObjectはあんまり使いたくないので、ツール→参照設定で「Microsoft Scripting Runtime」にチェックを入れてNewできるようにしといた。
リスト２
Option Explicit
Public Sub createChildWorkbook()
Dim originalWorkbook As Workbook
Set originalWorkbook = ThisWorkbook
Dim folderPath As String
folderPath = originalWorkbook.Path & "\収容所\" '"
If Dir(folderPath, vbDirectory) = "" Then MkDir (folderPath)
Dim fsObject As FileSystemObject '……(1)'
Set fsObject = New FileSystemObject
fsObject.CopyFile Source:=originalWorkbook.FullName, _
Destination:=folderPath & "子ブック.xlsm"
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Open(folderPath & "子ブック.xlsm") '……(2)'
newWorkbook.Worksheets("個別").Range("A1").Value = _
originalWorkbook.Worksheets("元データ").Range("B2").Value '……(3)'
Application.DisplayAlerts = False
newWorkbook.Worksheets("元データ").Delete
newWorkbook.Close True
Set newWorkbook = Nothing
Application.DisplayAlerts = True
End Sub
(1)からの３行、
Dim fsObject As FileSystemObject
Set fsObject = New FileSystemObject
fsObject.CopyFile Source:=originalWorkbook.FullName, _
Destination:=folderPath & "子ブック.xlsm"
では、FileSystemObjectオブジェクト用の変数にインスタンスをセット。
CopyFileメソッドを用いて新しいブック（子ブック）を別フォルダに保存してしまう。
(2)の
Set newWorkbook = Workbooks.Open(folderPath & "子ブック.xlsm")
では、新しくできた子ブックを開くとともに変数にぶち込み、
(3)の
newWorkbook.Worksheets("個別").Range("A1").Value = _
originalWorkbook.Worksheets("元データ").Range("B2").Value
でデータ（笑）を転記。
後は、「元データ」シートを削除して保存して閉じているだけ。
実行
このように、指定したフォルダに子ブックが保存されている。
子ブックを開くと、無事にデータ（笑）が転記されている。
おわりに
子ブックの生成については、ずいぶん簡単に書くことができた。
ただ、このやり方で困るのは、子ブックがxlsmのままになってしまうこと。
たぶん、前回の記事にid:imihito さんからいただいたコメントのやり方（SaveCopyAsメソッドを使う）でも同じことになると思う。
まあ、ちょっと調べたらできそうな気もするけど、今は本業がいっぱいいっぱいなので、それはまた別の機会に……。
