親ブックから子ブックを生成する
子ブック生成マクロ
親ブックから子ブックを生成する方法
先日、コチラの記事をうpしたところ、twitterのフォロワーさんから、
FileCopyステートメントでよくね???
的なリプをいただいたのだった。
私自身、
たかがブックの複製を作るぐらいのことでシートを1つ1つコピーした後余分なシートを削除していく
などというやり方は迂遠に過ぎると思っていたところだったので、使ったことなかったけど、FileCopyステートメントとやらを使ってみることにした。
準備
まずは、
こんな親ブックを用意した。
やりたい処理は、
- 「データ」シートB列にあるデータ(笑)を「個別」シートのA1セルに転記する
- A1セルにデータが書き込まれたブックを「子ブック」として別のフォルダに保存する
というもの。
最終的には、親ブックの「データ」シートにあるB列のデータ(笑)を1つづつ転記しては子ブックとして保存、という風にするのだけれど、とりあえず今回は
1つ目のデータ(「アホ」)を転記した子ブックを保存する
だけにしておく。
処理の手順
次のように考えた。
- FileCopyステートメントで親ブックのコピーを別フォルダに作る。
- 新しくできた子ブックを開く。
- データ(笑)を転記する。
- 子ブックを保存して閉じる。
コーディング
次のようにコードを書いた。
リスト1
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
実行
上記のコードを実行すると、
あっさり一蹴www
(*)のところでエラーが出ていた。
ちょいとggってみると、コチラのブログがヒット。
それによると、
ExcelのVBAでファイルをコピーする際に使用する"FileCopy"は開かれているファイルをコピーすることはできません。
とのこと。
で、
コピー元ファイルが閉じている(使用されていない)ことを保証できない場合は、ExcelのVBAの"FileCopy"を使用せずに"Scripting.FileSystemObject"の"CopyFile" を使用します。
ということ。なるほど、FileSystemObjectオブジェクトのCopyFileメソッドを使えばいいわけか。
コードの修正
次のように修正。ちなみに、CreateObjectはあんまり使いたくないので、ツール→参照設定で「Microsoft Scripting Runtime」にチェックを入れてNewできるようにしといた。
リスト2
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)からの3行、
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メソッドを使う)でも同じことになると思う。
まあ、ちょっと調べたらできそうな気もするけど、今は本業がいっぱいいっぱいなので、それはまた別の機会に……。