前提・実現したいこと
ファイル内の2シートをコピーして新しいブックとして保存し、
その後作成したファイルを複製するというマクロを作成したいです。
しかし私が作成したコードだとファイルを複製する箇所でエラーになり、原因がわからずにいます。
解決のために知恵をお貸しください。
【作成したマクロの概要】
元ファイルの2シートをAシート、Bシート
新ファイルの2シートをA'シート、B'シートと記載します。
① 元ファイルのAシート・Bシートをコピー
② ①を「テンプレート.xlsx」という名前をつけて、元ファイルと同じフォルダに保存
③ ②で作成したファイルのB'シートのデータがある範囲をコピー
④ ③でコピーしたセルをB'シートのA1セルに値で貼り付け
⑤ テンプレートファイルを上書き保存
⑥ テンプレートファイルを、ファイル名を指定して同じフォルダに複製
【その他質問】
Bシートは、元ファイルのCシートを参照しています。
そしてAシートはBシートを参照しています。
(Cシート←(参照)←Bシート←(参照)←Aシート)
AシートとBシートを分けて、テンプレートファイルにコピーしても、
A'シートの参照がB'シートになる方法はあるのでしょうか?
(BシートをB'シートにコピーしてから値で貼り付けするのではなく、
BシートからB'シートに直接値で貼り付けしたいのですが、
そうするとA'シートの参照先が、元ファイルのBシートになってしまいます。)
発生している問題・エラーメッセージ
下記コードの★の箇所で、「アプリケーション定義またはオブジェクト定義のエラーです」となります。 その後の処理でもエラーにある可能性はありますが、まだ確認はできておりません。 →解決しました 下記コードの★の箇所で「オブジェクトが必要です」となります。
該当のソースコード
VBA
1 2Option Explicit 3 4Dim mFSO As FileSystemObject 5 6Sub シート分割複製() 7 8 Dim myPath, folderPath As String 9 Dim newBook As Workbook 10 Dim rng As Range 11 12 Set mFSO = New FileSystemObject 13 myPath = ThisWorkbook.Path 14 folderPath = mFSO.GetFolder(myPath) 15 16 'Aシート、Bシートをコピー 17 Worksheets(Array("Aシート", "Bシート")).Copy 18 '新しいブックとして保存 19 ActiveWorkbook.SaveAs Filename:=folderPath & "\テンプレート" & Format(Now(), "yyyymmdd"), _ 20 FileFormat:=xlOpenXMLWorkbook 21 Set newBook = ActiveWorkbook 22 23 'B'シートのデータ範囲をコピー '~~/★ここでエラーになります~~ →解決しました 24 With newBook.Worksheets("Bシート") 25 Set rng = .Range(.Cells(1, 1), _ 26 Cells(.Cells(Rows.Count, 2).End(xlUp).Row, _ 27 .Cells(21, Columns.Count).End(xlToLeft).Column)) 28 'B'シートは複数テーブルがあり「.CurrentRegion」では正しくデータを取得できないため、 29 '上記のようにセル範囲を取得しています 30 31 rng.Copy 32 'A1セルに値で貼り付け 33 .Range("A1").PasteSpecial Paste:=xlPasteValues 34 End With 35 36 Application.CutCopyMode = False 37 38 newBook.Save 39 newBook.Close 40 41 'テンプレートファイルを同じフォルダに複製 '/★ここでエラーになります 42 FileCopy newBook, "folderPath" & "AAAファイル" & Format(Now(), "yyyymmdd") & ".xlsx""" 43 FileCopy newBook, "folderPath" & "BBBファイル" & Format(Now(), "yyyymmdd") & ".xlsx""" 44 FileCopy newBook, "folderPath" & "CCCファイル" & Format(Now(), "yyyymmdd") & ".xlsx""" 45 FileCopy newBook, "folderPath" & "DDDファイル" & Format(Now(), "yyyymmdd") & ".xlsx""" 46 47End Sub 48
回答2件
あなたの回答
tips
プレビュー