VBA 2つのファイルのマージ

Question

前提・実現したいこと

業務で2つのPCでシミュレーションした結果をひとつにまとめるプログラムを作りたい。
現在、1つにまとめることはできていますが、2つ目のシートの目次のようなもの(x,y,zのような1つ目のシートで
記載されている部分がまた出てしまっています。)
VBAに詳しくなく、ソースコードを見ても、セルのどこから読み取るなど(A2セルみたいな感じ)の情報がないため、
(たぶんシート内すべてを読み取っていると思いますが、、、)、その1行を消す方法がわかりません。
下記に簡単なシートの情報を記載します。

シート1 シート2
ｘ　ｙ　パターン数 ｘ　ｙ　パターン数
1 2 1 5 4 1
5 4 2 3 7 2
7 1 3 9 7 3

        ↓マージ後

ｘ　ｙ　パターン数
1 2 1
5 4 2
7 1 3
5 4 1
3 7 2
9 7 3

このようにしたいです。
現状はエラーメッセージの部分に記載。
シート1,2どちらもA1セルから始まっています。
よろしければ教えてください。

プラスαでパターン数を1.2.3.4.5.6.………のようにしたいですが、
今回はまず、マージできることが最優先なので余裕があれば教えていただきたいです。

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

↓マージ後
ｘ　ｙ　パターン数
1   2    1
5   4    2 
7   1    3
ｘ　ｙ　パターン数
5   4    1
3   7    2
9   7    3

該当のソースコード

Sub 結合()
 wpath = Range("B3")
 wfile = Dir(wpath & "\")
 flag = 0
 Do While wfile <> ""
If InStr(wfile, ".csv") Then
flag = flag + 1
If flag = 1 Then
FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv"
Open ThisWorkbook.Path & "\output.csv" For Output As #1
Close #1
End If
Open ThisWorkbook.Path & "\output.csv" For Append As #1
Open wpath & "\" & wfile For Input As #2
Do Until EOF(2)
Line Input #2, w_str
Print #1, w_str
Loop
Close #2
Close #1
End If
wfile = Dir()
 Loop

 MsgBox "マージ完了", vbInformation

 End Sub

試したこと

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

Answer 1

Sub test()
マージシート名 = "マージシート"　'マージ結果が出力されるシート

Sheets(マージシート名).Select
見出しxセル位置 = "A1" '各シート見出しが統一されていればx列のアドレス
見出し行 = 1 '見出し行
見出しx列 = 1 '見出しの中のxがある列
パターン数列 = 3 '見出しの中のパターン数がある列
見出しパターン数位置 = "C1"　'マージ結果シートのパターン数の見出しセル
x = 0
For i = 1 To Sheets.Count
    If Not Sheets(i).Name Like "*" & マージシート名 & "*" Then
        x = x + 1
        Sheets(i).Select
        Range(Cells(見出し行 + 1, 見出しx列), Cells(見出し行, パターン数列).End(xlDown)).Copy
        Sheets(マージシート名).Select
        If x = 1 Then
        Range(見出しxセル位置).Offset(1, 0).PasteSpecial (xlPasteAll)
        Else
        Range(見出しxセル位置).End(xlDown).Offset(1, 0).PasteSpecial (xlPasteAll)
        End If
    End If
Next i

With Range(見出しパターン数位置)
    .Offset(1, 0) = CStr("=row()-1")
    .Select
End With
Selection.Offset(1, 0).AutoFill Destination:=Range(Selection.Offset(1, 0), Selection.End(xlDown)), Type:=xlFillDefault　'パターン数列の調整

End Sub

シート数が多いと若干負荷高いかもしれませんがスクリーンアップデートを切ってから実行すればいいかもしれません

Answer 2

こんにちはこんばんは。よろしくおねがいいたします。
ちょうど仕事で似たようなものを作っていたところなので、ご紹介いたします。
ご参考になればよいのですが....

まとめたCSVをストレートにCSVにするのではなく、いったんシートの状態にしてから、そのあとにCSVで保存させるようにしました。

※CSVをインポートする方法はいろいろあります。私のこれが最善でも最適でもないです。

Option Explicit

Sub MatomeMultiCSVs()
'n個のCSVをユーザーが任意に選択して、”まとめシート”にまとめるプログラム
'個々のCSVは同じ配列（カラム数）をしているものとする
'（実際は、カラム数が違っていても読めてしまいますが）
'個々のCSVの1行目はヘッダであるものとする

Dim MatomeSheet As Worksheet
Set MatomeSheet = ThisWorkbook.Worksheets("まとめシート")

Dim SavingFileName As Variant 'まとめシートをCSVで保存するときのファイル名

'開くCSV群。複数あり。
Dim myCSVs As Variant

Dim I As Long '配列のインデックス番号

Dim f As Long '開くCSV群の数

Dim Header As String  'ヘッダ行を読むけど捨てるためだけに使っています

Dim r As Long 'レポートシートの行番号です

'一個のCSVの１行ぶんの文字列です
Dim strCSV As String

'一個のCSVの１行ぶんを、配列に格納するためのものです
Dim ArrCSV As Variant

Dim FileCount As Long '処理したファイルの数
Dim LineCount As Long '処理した行数

FileCount = 0 'ファイル数カウンタをリセット
LineCount = 0  '行数カウンタをリセット

'まとめシートを念のためクリアしておく
MatomeSheet.Cells.EntireColumn.Clear

'CSVを開きます
myCSVs = Application.GetOpenFilename( _
fileFilter:="CSVファイル,*.csv", _
Title:="読み込むCSVを選択してください. 複数選択が可能です.", _
MultiSelect:=True)

'キャンセルボタンを押された場合の処理
If IsArray(myCSVs) = False Then
  MsgBox "キャンセルされました"
  Exit Sub
End If

r = 1 'まとめシートの１行目からスタート

For f = 1 To UBound(myCSVs)
  'CSVファイルを開きます
  Open myCSVs(f) For Input As #1
    FileCount = FileCount + 1

    '２番目のCSV以降は、１行目（ヘッダ）は読み込むが使わない
    If f > 1 Then
      Line Input #1, Header
    End If
        
    Do Until EOF(1)
      Line Input #1, myCSVs(f)
                
      'CSVの一行分を、配列に格納します
      ArrCSV = Split(myCSVs(f), ",")
      For I = 0 To UBound(ArrCSV)
        MatomeSheet.Cells(r, I + 1) = ArrCSV(I)
      Next I

      'ここで行送りします
      r = r + 1
      LineCount = LineCount + 1
      'CSVファイルの次の行へシフトします
    Loop
        
 'CSVファイルを閉じます
 Close #1

Next f

'まとめシートをアクティベートします
MatomeSheet.Activate

MsgBox "処理が完了しました" & vbNewLine & _
            "処理したCSVのファイル数 = " & FileCount & vbNewLine & _
            "処理した行数 = " & LineCount

'まとめシートをCSVで保存する
SavingFileName = Application.GetSaveAsFilename(InitialFileName:="まとめ.csv", _
fileFilter:="CSVファイル,*.csv", _
Title:="まとめCSVの保存先を指定してください")

'キャンセルボタンを押された場合の処理
If SavingFileName = False Then
MsgBox "キャンセルされました"
Exit Sub
End If

MatomeSheet.SaveAs SavingFileName, FileFormat:=xlCSV
MsgBox "保存しました"

End Sub

Answer 3

テストしていませんが
どうでしょうか

Sub 結合()
 wpath = Range("B3")
 wfile = Dir(wpath & "\") 'B3セルのパス内のファイル
 flag = -1 '1行目（項目）カウントで０にする

'一つ目のファイル
If InStr(wfile, ".csv") Then
    
        FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv"
        '一つ目のファイルをoutput.csvとしてコピーする
        'コピー完了待ち?  非同期エラーでないか？
        '
        Open ThisWorkbook.Path & "\output.csv" For Input As #1　'＊修正
            Do Until EOF(1)
                Line Input #1, w_str
                flag = flag + 1      '一つ目のファイルの行数カウント
            Loop
        Close #1
        '一つ目のファイル完了
End If

wfile = Dir()
'二つ目のファイルからループ
Do While wfile <> ""
    If InStr(wfile, ".csv") Then
        'ThisWorkbook.Path\output.csv は毎回開いた方が安全？
        Open ThisWorkbook.Path & "\output.csv" For Append As #1
        Open wpath & "\" & wfile For Input As #2
            '一ライン目破棄
            Line Input #2, w_str
            '二ライン目から追記
            Do Until EOF(2)
                flag = flag + 1  '通し番号のパターン数
                Line Input #2, w_str
                'w_str_R = Replace(w_str, Str(flag2), Str(flag), 8)　’？？
                w_str_R = Left(w_str, 8) & String(4 - Len(Str(flag)), " ") & Str(flag) ' 8文字目以降を通し番号に置き換え（右揃え必要？）
                Print #1, w_str_R
            Loop
        Close #2
        Close #1
    End If
    wfile = Dir()
Loop

MsgBox "マージ完了", vbInformation

End Sub

Answer 4

やっつけですが、こんな感じでしょうか。
もちろん動作確認はしていません！

Sub 結合()
	wpath = Range("B3")
	wfile = Dir(wpath & "\")
	flag = 0
	Do While wfile <> ""
		If InStr(wfile, ".csv") Then
			flag = flag + 1
			If flag = 1 Then
				FileCopy wpath & "\" & wfile, ThisWorkbook.Path & "\output.csv"
				Open ThisWorkbook.Path & "\output.csv" For Output As #1
				Close #1
			End If
			Open ThisWorkbook.Path & "\output.csv" For Append As #1
			Open wpath & "\" & wfile For Input As #2
			' 1行目
			Line Input #2, w_str
			If flag = 1 Then
				Print #1, w_str
			End If
			' 2行目以降
			Do Until EOF(2)
				Line Input #2, w_str
				Print #1, w_str
			Loop
			Close #2
			Close #1
		End If
		wfile = Dir()
	Loop

	MsgBox "マージ完了", vbInformation

End Sub

Comments

[kitagawasho]

outputが出てきません、、、
このワークシートと同じ場所に出ると思っていますが違う場所に出力されますか？

[ttyp03]

えっと、ファイルに出力されるんですが…

[sinzou]

ThisWorkbook.Path & "\output.csv"

xlsmファイル保存されてれば、作成されるかと…

[ttyp03]

昨日は取り急ぎ回答しましたが、再度確認です。
ご提示のコードは複数のCSVファイルをマージして、別のファイル(output.csv)に出力するものです。
もしワークシートに出力（表示）したいというのであればまったくの別物なので改めてそのコードの提示をお願いします。
ただ現状の物でもoutput.csvをExcelで開けば確認したいことはできていると思います。
「VBAに詳しくない」とかよりも、まずは要件・仕様をよく確認してください。
あとたぶんワークブックとかCSVファイルとか同じものと思われている節があるので、用語の確認もお願いします。

[kitagawasho]

朝確認したら、パスが違っていました。。。
自分の確認不足です。
本当にすみません。。。
outputが出ることを確認しました。
対応ありがとうございました。。