親ブックから子ブックを生成する

子ブック生成マクロ

親ブックから子ブックを生成する方法

akashi-keirin.hatenablog.com

先日、コチラの記事をうpしたところ、twitterのフォロワーさんから、

FileCopyステートメントでよくね???

的なリプをいただいたのだった。

私自身、

たかがブックの複製を作るぐらいのことでシートを1つ1つコピーした後余分なシートを削除していく

などというやり方は迂遠に過ぎると思っていたところだったので、使ったことなかったけど、FileCopyステートメントとやらを使ってみることにした。

準備

まずは、

f:id:akashi_keirin:20170812143753j:plain

f:id:akashi_keirin:20170812143800j:plain

こんな親ブックを用意した。

やりたい処理は、

  • 「データ」シートB列にあるデータ(笑)を「個別」シートのA1セルに転記する
  • A1セルにデータが書き込まれたブックを「子ブック」として別のフォルダに保存する

というもの。

最終的には、親ブックの「データ」シートにあるB列のデータ(笑)を1つづつ転記しては子ブックとして保存、という風にするのだけれど、とりあえず今回は

1つ目のデータ(「アホ」)を転記した子ブックを保存する

だけにしておく。

処理の手順

次のように考えた。

  1. FileCopyステートメントで親ブックのコピーを別フォルダに作る。
  2. 新しくできた子ブックを開く。
  3. データ(笑)を転記する。
  4. 子ブックを保存して閉じる。

コーディング

次のようにコードを書いた。

リスト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

実行

上記のコードを実行すると、

f:id:akashi_keirin:20170812143808j:plain

あっさり一蹴www

(*)のところでエラーが出ていた。

ちょいとggってみると、コチラのブログがヒット。

それによると、

ExcelVBAでファイルをコピーする際に使用する"FileCopy"は開かれているファイルをコピーすることはできません。

とのこと。

で、

コピー元ファイルが閉じている(使用されていない)ことを保証できない場合は、ExcelVBAの"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

でデータ(笑)を転記。

後は、「元データ」シートを削除して保存して閉じているだけ。

実行

f:id:akashi_keirin:20170812143817j:plain

このように、指定したフォルダに子ブックが保存されている。

f:id:akashi_keirin:20170812143853j:plain

子ブックを開くと、無事にデータ(笑)が転記されている。

おわりに

子ブックの生成については、ずいぶん簡単に書くことができた。

ただ、このやり方で困るのは、子ブックがxlsmのままになってしまうこと。

たぶん、前回の記事id:imihito さんからいただいたコメントのやり方(SaveCopyAsメソッドを使う)でも同じことになると思う。

まあ、ちょっと調べたらできそうな気もするけど、今は本業がいっぱいいっぱいなので、それはまた別の機会に……。

@akashi_keirin on Twitter