選択範囲のコピーと別ファイルへのペースト

Question

前提・実現したいこと

VBAを使って、複数ファイルの内容を１つのファイルに統合するプログラムを書こうとしています。

発生している問題・エラーメッセージ

元ファイルの内容をコピーして、新しいブックのシートにペーストするコードの部分でエラーが発生します。

実行時エラー'438'
オブジェクトは、このプロパティまたはメソッドをサポートしていません。

というエラーが発生します。

該当のソースコード

デバッグすると下記の行が指定されます。

.Range(.Cells(1, 1), .Cells(EndRow, Endcolumn)).Copy Workbooks(NewBook).Wroksheets(NewSht).Rows(1)

全体のソースは下記となります。

Sub IntegPro()


'変数宣言

    Dim MacroBook As String
    Dim MacroSht As String
    Dim InputPath As String
    Dim OutputPath As String
    Dim Outputfile As String
    Dim InputFile As String
    Dim i As Integer
    Dim NewBook As String
    Dim NewSht As String
    Dim EndRow As Long
    Dim Endcolumn As Integer
    Dim DataBook As String
    Dim Datasht As String
    
'実行ファイルとシートの定義
        MacroBook = ActiveWorkbook.Name
        MacroSht = ActiveSheet.Name
        
'新規ブックを作成し、それのブックとシートを定義する
    Workbooks.Add
    NewBook = ActiveWorkbook.Name
    NewSht = ActiveSheet.Name
    
'入力パスや出力パス、出力ファイルの定義
    With Workbooks(MacroBook).Worksheets(MacroSht)
    .Activate
    InputPath = .Cells(2, 3).Value & "\"
    OutputPath = .Cells(3, 3).Value & "\"
    Outputfile = .Cells(4, 3).Value
    End With
    
'入力ファイルを定義
    i = 0
    Do While Workbooks(MacroBook).Worksheets(MacroSht).Cells(7 + i, 3).Value <> ""
    
    'ファイルを開く
        Workbooks.Open InputPath & Workbooks(MacroBook).Worksheets(MacroSht).Cells(7 + i, 3).Value
        
    '定義する
        DataBook = ActiveWorkbook.Name
        Datasht = ActiveSheet.Name
        
        'データファイルの最終行と最終列を記憶する
        With Workbooks(DataBook).Worksheets(Datasht)
            EndRow = .Cells(Rows.Count, 1).End(xlUp).Row
            Endcolumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        
            '開いたファイルのデータ部分をコピペする。（１回目だけデータ名もコピペする）
            If i = 0 Then
        
            '１回目だけ
            .Range(.Cells(1, 1), .Cells(EndRow, Endcolumn)).Copy Workbooks(NewBook).Wroksheets(NewSht).Rows(1)
        
            Else:
        
            '2回目以降
            .Range(.Cells(2, 1), .Cells(EndRow, Endcolumn)).Copy Workbooks(NewBook).Wroksheets(NewSht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        
            End If
        
            'データファイルを閉じる
            Workbooks(DataBook).Close SaveChanges:=False
            
        End With
        i = i + 1
    Loop
    
    '統合したファイルを名前を付けて保存
        Workbooks(NewBook).Worksheets(NewSht).Activate
        ActiveWorkbook.SaveAs Filename:= _
        OutputPath & Outputfile & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        
        
    '閉じる
        ActiveWindow.Close
End Sub

試したこと

末尾のRows(1)の部分をCells(1,1)に指定したり試してみましたが、原因がわかりません。

補足情報（FW/ツールのバージョンなど）

.Range(.Cells(1, 1), .Cells(EndRow, Endcolumn)).Copy

の部分は、元ファイルでの動作になります。

Workbooks(NewBook).Wroksheets(NewSht).Rows(1)の部分の、
下記変数は、VBAで新規作成したブックを指定しています。
NewBook
NewSht

解決方法をご存知の方、ご教示のほどよろしくお願い致します。

Comments

[segavvy]

以下のようなコードだと思うのですが、手元の環境では動いてしまいました。何か差異はありそうでしょうか。環境はWindows 10、Excel 2016です。

Sub test()
With ActiveSheet
EndRow = 1
Endcolumn = 5
NewBook = "Book2"
NewSht = "Sheet1"

.Range(.Cells(1, 1), .Cells(EndRow, Endcolumn)).Copy Workbooks(NewBook).Worksheets(NewSht).Rows(1)

End With
End Sub

[hatena19]

NewBook, NewSht の変数宣言、代入部分のコードも提示してください。
おそらく、NewBook, NewSht がString型でなくオブジェクト型で宣言しているのが原因のような予感。

[tuckQ]

回答いただきありがとうございます。
NewBook, NewSht がString型で指定しているのですが、うまくいっておりません。
全体のコードを追記しましたので、ご確認いただければ幸いです。

Answer 1

Wroksheets -> worksheets
Rows(1) -> Cells(1,1)
ですかね。

Comments

[hatena19]

私もそれを疑いましたか、実験してみたら、Rows(1)でもエラーなくコピーできました。

[MrIgat]

>実行時エラー'438'
このエラーは、「Wroksheets」のスペル違いと思います。

>Rows(1)でもエラーなくコピーできました。
Rows(1)にすると、私の環境ではすべての列（XFD列まで）にペーストされます。
今回の場合は左上のセルだけにするのが適切かと思いました。

[hatena19]

「Wroksheets」あっ、たしかにスペルミスですね。気が付かなかった。(;^ω^)
原因はこれですね。

Rows(1) は私の環境では、コピー元のセル範囲と同じサイズにペーストされますね。
ただ、Cells(1,1) の方が誤解されることがないので適切ですね。

[MrIgat]

Rows()でも問題ない場合を検証してみましたら、私の環境ではcopyするセルの列数が5列以上の場合は、Rowsでも問題ありませんでした。
4列未満の場合はXFD列までペーストされました。

[hatena19]

検証ありがとうござます。そうなんですね。私も勉強になりました。
ただ、わざわざRows(1)を使うメリットはないと思いますので、Cells(1,1) がいいですよね。

[tuckQ]

ご指摘のように、Wroksheets -> worksheetsが原因だったようで、修正したところ、正常に動作しました。初歩的なミスで恐縮です。ありがとうございました！

Answer 2

~~実際のブックがないと検証は難しいので原因は分かりませんが、~~iruyasさんの回答のスペルミスが原因だと思われます。

下記の点を考慮して書き直してみました。（今後のコーティング時のご参考にしてください。）

• Activeなオブジェクトを対象とすることを前提にしたコードは避ける。

（読みづらいし、想定したものがアクティブでなかったりとバグの原因になりやすい）

• 変数をString型にしてオブジェクト名でオブジェクトを参照せずに、変数をオブジェクト型にして直接参照したほうがシンプルになりコードが読みやすい。

Sub IntegPro()

    '変数宣言
    Dim MacroBook As Workbook
    Dim MacroSht As Worksheet
    Dim InputPath As String
    Dim OutputPath As String
    Dim Outputfile As String
    Dim InputFile As String
    Dim i As Integer
    Dim NewBook As Workbook
    Dim NewSht As Worksheet
    Dim DataBook As Workbook
    Dim DataSht As Worksheet
    Dim EndCell As Range

    '実行ファイルとシートの定義　Activeなのが前提のコードは避けるべき
    Set MacroBook = ThisWorkbook
    Set MacroSht = MacroBook("入力パスや出力パス、出力ファイルの定義してあるシート名")

    '新規ブックを作成し、それのブックとシートを定義する
    Set NewBook = Workbooks.Add
    Set NewSht = NewBook.Worksheets(1)

    '入力パスや出力パス、出力ファイルの定義
    With MacroSht
        InputPath = .Cells(2, 3).Value & "\"
        OutputPath = .Cells(3, 3).Value & "\"
        Outputfile = .Cells(4, 3).Value
    End With

    i = 0
    Do While MacroSht.Cells(7 + i, 3).Value <> ""

        'データファイルを開く
        Set DataBook = Workbooks.Open(InputPath & MacroSht.Cells(7 + i, 3))
        'データシートを定義する
        DataSht = DataBook.Worksheets(1)

        With DataSht
            'データファイルの最終セルを記憶する
            Set EndCell = .Range(.Cells(Rows.Count, 1).End(xlUp), _
                                 .Cells(1, Columns.Count).End(xlToLeft))

            '開いたファイルのデータ部分をコピペする。（１回目だけデータ名もコピペする）
            If i = 0 Then

                '１回目だけ
                .Range(.Cells(1, 1), EndCell).Copy NewSht.Cells(1, 1)

            Else

                '2回目以降
                .Range(.Cells(2, 1), EndCell).Copy _
                    Destination:=NewSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

            End If

            'データファイルを閉じる
            DataBook.Close SaveChanges:=False

        End With
        i = i + 1
    Loop

    '統合したファイルを名前を付けて保存
    NewBook.SaveAs Filename:=OutputPath & Outputfile & ".xlsx", _
                   FileFormat:=xlOpenXMLWorkbook, _
                   CreateBackup:=False

    '閉じる
    NewBook.Close
End Sub

Comments

[tuckQ]

全体的なコードの書き換えまでして頂きありがとうございました。アドバイス頂いた点、再学習して今後に活かせるようにしたいと思います！

Answer 3

＞下記変数は、VBAで新規作成したブックを指定しています。

その部分のコードも提示してください。

Comments

[tuckQ]

ご回答ありがとうございます。
全体のコードを追記しましたので、ご確認いただければ幸いです。