Excel VBA: フォルダ内にある複数ファイルの指定した列を、結合用のシートに右に結合

Question

ExcelのVBAを用いて、フォルダ内にある複数ファイルの指定した列を、結合用のシートに右に結合したい。

VBA初心者です。

複数のExcelファイルからのコピペを自動化するExcelマクロ・RPA UiPathの比較

上記のサイトを参考に、以下のようなことをしたいと考えております。

・フォルダ内に1 (1), 1 (2), ...... , 1 (26)というエクセルファイル(xlsx)がある。
・それぞれB列からD列をコピーし、結合用のマクロファイルのmergeシートに右に右に貼り付け結合したい。
隣に並べていきたい。

例
1 (1).xlsx Sheet5

A	B	C	D	E
30	12	44	85	62
14	65	23	69	40

1 (2).xlsx Sheet5

A	B	C	D	E
17	11	42	45	2
8	23	98	34	45

---

結合用のマクロファイルのmergeシート

A	B	C	D	E	F
12	44	85	11	42	45
65	23	69	23	98	34

上記のサイトではファイルの数が変わっても大丈夫ですが
下に下に結合されてしまいます。

どのように変更すればよいかご教授お願い致します。

エクセルのバージョンは最新版でも大丈夫ですが、
可能であればExcel2007用のものを教えて頂きたいです。

やってみたこと
Workbooks(MergeWorkbook).Worksheets(i).Range("B:D").Copy
Cells(1, i + 3).PasteSpecial
Application.CutCopyMode = False

追記
・一つのエクセルファイルにつき、コピー対象のシートは一つです。
コピー対象でないシートはあると思いますが、コピー対象のシート名は共通です。(Sheet5など)

・データは、結合するデータの元となるファイル(1 (1).xlsxなど）のファイル名でソートした順番で並べたいと考えております。
1 (1).xlsxのSheet5のB列からD列　→　1 (2).xlsxのSheet5のB列からD列→　……

・『「フォルダ内にある複数ファイル」を読み込む処理』については、上記のサイトの
Sub folder()
Sub shuukei()
こちらの処理を参考にしております。

MergeWorkbook_data = Workbooks(MergeWorkbook).Worksheets(i).Range("a" & Rows.Count).End(xlUp).Row
ThisWorkbook_data = ThisWorkbook.Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Row
Workbooks(MergeWorkbook).Worksheets(i).Rows("2:" & MergeWorkbook_data).Copy ThisWorkbook.Worksheets("merge").Range("a" & ThisWorkbook_data + 1)

下でなく横につなげるためにはこのあたりを変更しなければならないと思っていますが、
うまくいっていない状態です。

Comments

[meg_]

> 結合用のマクロファイルのmergeシート
上記でA列が「12, 65」となるのはどういうロジックですか？

[unknown1432]

ご質問ありがとうございます。
上記の例では、元となるデータが入っているファイルのB列からD列を
結合用のマクロファイルのmergeシートのA列から順番に右に並べております。
まず1 (1).xlsxのB列からD列をコピーし、
mergeシートのA1に貼り付けているというような感じでしょうか。

[unknown1432]

次に1 (2).xlsxのB列からD列をコピーし、
３列後のD1に？（D～F列に）貼り付けております。
以後、フォルダ内にあるすべてのファイルのB列からD列をコピーし
mergeシートの３列後に追加することを繰り返します。

[meg_]

エクセルシートのB列からD列をコピーして右へ繋げたい、ということでしょうか？

コード中で「Worksheets(i)」がありますが、エクセルファイルにコピー対象のシートは複数あるのでしょうか？

> フォルダ内にある複数ファイル
データを繋げる順番に制限はあるのでしょうか？（ファイル名でソート等）

[unknown1432]

説明不足で申し訳ありません。
コピー対象のシートは一つです。
コピー対象でないシートはあると思いますが、コピー対象のシート名は共通です。(Sheet5など)

データはファイル名でソートした順番で並べたいと考えております、
上記のサイトのコードでは、ソートされた順番で繋がっております。

[unknown1432]

>エクセルシートのB列からD列をコピーして右へ繋げたい、ということでしょうか？
はい。その通りです。

[meg_]

・「フォルダ内にある複数ファイル」を読み込む処理についてはコードは書けているということで良いでしょうか？
・結合ルールについては質問に追記してください。

[unknown1432]

＞「フォルダ内にある複数ファイル」を読み込む処理についてはコードは書けているということで良いでしょうか？
Sub folder()
Sub shuukei()
上記サイトのマクロを参考に書けていると思います。現在悩んでいる点は質問に追記しております。
＞・結合ルールについては質問に追記してください。
変更致しました。

Answer 1

『「フォルダ内にある複数ファイル」を読み込む処理』は実装済との前提でデータコピー処理について回答します。

Sub test()

    Dim files(3) As String
    Dim i As Integer
    Dim mergeRow As Integer
    Dim mergeBook As Workbook
    Dim copyBook As Workbook
    
    
    files(1) = "1.xlsx"
    files(2) = "2.xlsx"
    files(3) = "3.xlsx"
    
    Set mergeBook = Workbooks.Open("mergeBook.xlsx")
    
    For i = 1 To 3
        Set copyBook = Workbooks.Open(files(i))
        If mergeBook.Sheets(1).Cells(1, 1).Value = "" Then
            copyBook.Sheets("sheet5").Columns("B:D").Copy mergeBook.Sheets(1).Cells(1, 1)
        Else
            copyBook.Sheets("sheet5").Columns("B:D").Copy mergeBook.Sheets(1).Cells(1, 1).End(xlToRight).Offset(0, 1)
        End If
        copyBook.Close
    Next i

End Sub

Comments

[unknown1432]

回答頂きありがとうございます。
```ja-vba
Sub test()

Dim files(3) As String
Dim i As Integer
Dim abc As String
Dim mergeRow As Integer
Dim mergeBook As Workbook
Dim copyBook As Workbook

files(1) = ThisWorkbook.Path & "\1.xlsx"
files(2) = ThisWorkbook.Path & "\2.xlsx"
files(3) = ThisWorkbook.Path & "\3.xlsx"

abc = ThisWorkbook.Path & "\TEST.xlsx"

' Set mergeBook = Workbooks.Open("mergeBook.xlsm")
Workbooks.Open FileName:=abc

For i = 1 To 3
Set copyBook = Workbooks.Open(files(i))
If mergeBook.Sheets(1).Cells(1, 1).Value = "" Then 'ここで実行時エラー91
copyBook.Sheets("sheet5").Columns("B:D").Copy mergeBook.Sheets(1).Cells(1, 1)
Else
copyBook.Sheets("sheet5").Columns("B:D").Copy mergeBook.Sheets(1).Cells(1, 1).End(xlToRight).Offset(0, 1)
End If
copyBook.Close
Next i

End Sub
```
教えて頂いた内容をもとに書いてみたのですが、
If mergeBook.Sheets(1).Cells(1, 1).Value = "" Then
どこが間違っているかご指摘いただけますでしょうか。
実行時エラー91
オブジェクト変数またはWithブロック変数が設定されていません。
というエラーが発生しました。

[meg_]

> Set mergeBook = Workbooks.Open("mergeBook.xlsm")
上記コードをコメントアウトしているためmergeBookがNothingなのでは？
何故コメントアウトしてしまったのでしょうか？

[unknown1432]

以下のように修正することで、望んでいた通りになりました。
本当にありがとうございました。

＞何故コメントアウトしてしまったのでしょうか？
間違ってコメントアウトしてしまったようです。

```vba
Sub test()

Dim files(3) As String
Dim i As Integer
Dim abc As String
Dim mergeRow As Integer
Dim mergeBook As Workbook
Dim copyBook As Workbook

files(1) = ThisWorkbook.Path & "\1.xlsx"
files(2) = ThisWorkbook.Path & "\2.xlsx"
files(3) = ThisWorkbook.Path & "\3.xlsx"

abc = ThisWorkbook.Path & "\TEST.xlsx"

Set mergeBook = Workbooks.Open(ThisWorkbook.Path & "\merge.xlsx")
Workbooks.Open FileName:=abc

For i = 1 To 3
Set copyBook = Workbooks.Open(files(i))
If mergeBook.Sheets(1).Cells(1, 1).Value = "" Then
copyBook.Sheets("sheet5").Columns("B:D").Copy mergeBook.Sheets(1).Cells(1, 1)
Else
copyBook.Sheets("sheet5").Columns("B:D").Copy mergeBook.Sheets(1).Cells(1, 1).End(xlToRight).Offset(0, 1)
End If
copyBook.Close
Next i

End Sub
```