EXCEL VBA ブック間シートコピーでのエラー回避策

EXCEL VBAで、新たにブックを生成して既存ブックのあるシートを
新規ブックにコピーするというコードを書いてみたのですが、

以下のようなエラーが発生しました。

移動先またはコピー先のブックの行列数が元のブックの行列数よりも少ないため、
シートを移動先またはコピー先のブックに挿入できません。
データを別のブックに移動またはコピーするには、データを選択して、
[コピー]コマンドと[貼り付け]コマンドを使用して移動先または
コピー先のブックのシートに挿入してください。

これを回避するために色々と調べた結果、
出来上がったコードが以下なのですが、
もっとスマートなコードで実現する方法がありましたら、
ご教示いただけますでしょうか。

VBA
1    Dim myBook As String
2    myBook = ActiveWorkbook.Name 'このブックのファイル名を保存
3          
4    Workbooks.Add '新規ワークブックを作成
5    
6    Dim fullPath As String
7    fullPath = ActiveWorkbook.Path & "\newBook.xlsx"
8    
9    Application.DisplayAlerts = False
10    ActiveWorkbook.SaveAs fullPath, xlOpenXMLWorkbook
11    Application.DisplayAlerts = True
12
13    'xlsx形式だとEXCELに認識させるために、一旦閉じてから再度オープンする
14    ActiveWorkbook.Close
15    Workbooks.Open fullPath
16    
17    Workbooks(myBook).Activate
18    Worksheets("元シート").Activate
19 
20    ThisWorkbook.Sheets("元シート").Copy _
21    Before:=Workbooks("newBook.xlsx").Sheets("Sheet1")

行動規範の内容に同意します

回答3件

二つのWorkbookを、それぞれWookbook型の変数に代入すると見通しが良くなりそうに思います。

ActiveWorkbookとかThisWorkbookは、コードのその箇所で何を参照しているのかが判りにくいです。
それに変えて、内容が判るような名前の変数を使うと、コードが理解しやすくなりますよ。

    Dim origWB as Workbook, newWB as Workbook '二つのWorkbookを入れる変数を用意する

    Set origWB = ActiveWorkbook　'もとのワークブックを変数 origWB に入れる
    Set newWB = Workbooks.Add '新規ワークブックを作成して、変数 newWB に入れる

    Application.DisplayAlerts = False
    newWB.SaveAs ActiveWorkbook.Path & "\newBook.xlsx" '作成したワークブックを名前を付けて保存
    Application.DisplayAlerts = False

    origWB.Sheets("元シート").Copy Before:=newWB.Sheets("Sheet1")　'シートのコピー

    newWB.Save   '新規ワークブックを保存
    newWB.close  '新規ワークブックを閉じる
    origWB.close '元のワークブックを閉じる

投稿2019/11/06 01:13

coco_bauer

総合スコア6915

SYO_chan

2019/11/06 02:18

coco_bauerさんありがとうございます。早速、試してみたのですが、シートのコピーの所で質問内容と同じエラーが発生しました。

garucia

2019/11/06 02:42

hoge.xlsx内のシートを、hoge.xls内にコピーしようとしてませんか？

SYO_chan

2019/11/06 05:11

garuciaさんコメントありがとうございます。その点は大丈夫です。

SYO_chan

2019/11/06 05:46

hatena19さんのアドバイスメニューのファイル→オプション→保存の「ファイルの保存形式」が「Excel 97-2003ブック」になっていたら、「Excelブック(*.xlsx)」に変更してみてください。これで、上記コメントの問題とそもそもの質問内容のエラーの両方が解決しました。

行動規範の内容に同意します

ベストアンサー

もっとスマートなコードで実現する方法がありましたら、

ご教示いただけますでしょうか。

何をスマートとするかはそれぞれでしょうが、

アクティブなブック、シートを対象に操作する方法だと、
Activateでフォーカスを切り替える必要があり、無駄な処理が発生する。
また、コードを読むとき何がActivateか意識する必要があり読みづらく、バグのもとになりやすい。

アクティブでなくてもたいていの操作はできるので、そのものを対象にして操作する、という方針でコーディングするといいでしょう。

vba
1    Dim myBook As Workbook
2    Set myBook = ThisWorkbook 'コードの記述してあるブック ActiveWorkbook
3
4    Dim newBook As Workbook
5    Set newBook = Workbooks.Add '新規ワークブックを作成
6
7    Dim fullPath As String
8    fullPath = myBook.Path & "\newBook.xlsx"
9    Application.DisplayAlerts = False
10    ActiveWorkbook.SaveAs fullPath, xlOpenXMLWorkbook
11    Application.DisplayAlerts = True
12
13    'xlsx形式だとEXCELに認識させるために、一旦閉じてから再度オープンする←これ必要ですか？
14    'newBook.Close
15    'Set newBook = Workbooks.Open(fullPath)
16
17    myBook.Sheets("元シート").Copy _
18    Before:=newBook.Sheets(1)