複数のCSVファイルを読み込んで複数シートを1ブックとしたい

質問

始めまして。
VBA初心者です。
2枚のCSVファイルをダイアログで各々指定し、保存する2枚のシートを1ブックにまとめたいのですが、うまくいきません。
現状は以下のようなマクロですが、別々のシートとなります。
よろしくお願い致します。

Sub 選択されたPDPファイルを開いて読み込む()
With Application.FileDialog(msoFileDialogOpen)
.Title = "ファイルを選択して［OK］ボタンをクリックしてください"
.AllowMultiSelect = False '複数選択不可
.Filters.Clear
.Filters.Add "1枚目", "*.csv", 1
If .Show = -1 Then .Execute 'キャンセルでなければ開く
End With

With Application.FileDialog(msoFileDialogOpen)
.Title = "2つめのファイルを選択して［OK］ボタンをクリックしてください"
.AllowMultiSelect = False '複数選択不可
.Filters.Clear
.Filters.Add "2枚目", "*.csv", 1
If .Show = -1 Then .Execute 'キャンセルでなければ開く

End With
End Sub

回答No.5

Wendy02 · ベストアンサー

こんにちは。

こちらにはレスはつかないかもしれませんが、コードを出しておきます。
ファイルオープン・ダイアログで、複数のCSVファイルを選択してください。
マルチセレクトにしてあります。

'標準モジュール

Sub CSVImportSheets()
Dim FileNames As Variant
Dim fn As Variant

　FileNames = Application.GetOpenFilename _
　　("CSV(*.csv),*.csv", MultiSelect:=True)
　If VarType(FileNames) = vbBoolean Then Exit Sub

　For Each fn In FileNames
　　Worksheets.Add After:=Worksheets(Worksheets.Count)
　　With ActiveSheet.QueryTables.Add(Connection:= _
　　　　"TEXT;" & fn, _
　　　　Destination:=Range("A1"))
　　　　.Name = ActiveSheet.Name
　　　　.FieldNames = True
　　　　.RowNumbers = False
　　　　.FillAdjacentFormulas = False
　　　　.PreserveFormatting = True
　　　　.RefreshOnFileOpen = False
　　　　.RefreshStyle = xlInsertDeleteCells
　　　　.SaveData = True
　　　　.AdjustColumnWidth = False
　　　　.RefreshPeriod = 0
　　　　.TextFilePromptOnRefresh = False
　　　　.TextFilePlatform = 932
　　　　.TextFileStartRow = 1
　　　　.TextFileParseType = xlDelimited
　　　　.TextFileTextQualifier = xlTextQualifierDoubleQuote
　　　　.TextFileConsecutiveDelimiter = False
　　　　.TextFileTabDelimiter = False
　　　　.TextFileCommaDelimiter = True
　　　　.TextFileTrailingMinusNumbers = True
　　　　.Refresh BackgroundQuery:=False
　　End With
　　　　ActiveSheet.UsedRange.QueryTable.Delete
　Next fn
End Sub

お礼

早速のご回答有難うございました。
早速試してみましたが私の思うような内容でした。
大変参考になりました。
また、機会ありましたらよろしくお願い致します。

回答No.4

Wendy02

こんにちは。

>選択したcsvファイルを1ブックに複数シート作成したかったのですが、ご質問の書き方が不十分でした。

QueryTable で、シートにインポートすればよいのでは？

回答No.3

Wendy02

こんばんは。

VBAで作らなくてはも、単に、二つのCSV を足すなら、コマンドプロンプトでしてしまえばよいのではありませんか？

copy test01.csv+test02.csv test03.csv

これで、test03.csv という結合ファイルが出来ますけれども。

もし、VBAで行いたいなら、それぞれのファイル名を確保して、Shell で行えばよいだけです。

回答No.2

zap35

＃０１です。読み込むCSVが２つなら先のコードで問題がありませんが、将来的に数が増えることを想定し最後から６行目を変更します

変更前
ActiveSheet.Cells(Selection.Rows.Count + 1, 1).Select

変更後
ActiveSheet.Cells(ActiveCell.CurrentRegion.Rows.Count + 1, 1).Select

なお余談ですがファイルの選択もFor～Nextに入れてしまえば、コードもすっきりすると思いますよ

お礼

早速のご回答有難うございました。
非常に参考になりました。
選択したcsvファイルを1ブックに複数シート作成したかったのですが、ご質問の書き方が不十分でした。
研究してみます。
ありがとうございました。

回答No.1

zap35

考え方としては２つのCSVファイルを開いて、それぞれのシートをコピーして、マクロが登録されている元のブックに貼り付ける方法が素直だと思います。ちょっとベタですがこんな具合です

Sub Test()
Dim bkName(2) As String
Dim wb As Workbook
Dim idx As Integer
　Set wb = ActiveWorkbook
　Range("A1").Select

　With Application.FileDialog(msoFileDialogOpen)
　　.Title = "ファイルを選択して［OK］ボタンをクリックしてください"
　　.AllowMultiSelect = False '複数選択不可
　　.Filters.Clear
　　.Filters.Add "1枚目", "*.csv", 1
　　If .Show = -1 Then .Execute 'キャンセルでなければ開く
　End With
　bkName(1) = ActiveWorkbook.Name

　With Application.FileDialog(msoFileDialogOpen)
　　.Title = "2つめのファイルを選択して［OK］ボタンをクリックしてください"
　　.AllowMultiSelect = False '複数選択不可
　　.Filters.Clear
　　.Filters.Add "2枚目", "*.csv", 1
　　If .Show = -1 Then .Execute 'キャンセルでなければ開く
　End With
　bkName(2) = ActiveWorkbook.Name
　For Idx = 1 To 2
　　Workbooks(bkName(Idx)).Activate
　　Cells.CurrentRegion.Copy
　　wb.Activate
　　ActiveSheet.Paste
　　ActiveSheet.Cells(Selection.Rows.Count + 1, 1).Select
　Next Idx
　Application.CutCopyMode = False
　Workbooks(bkName(1)).Close False
　Workbooks(bkName(2)).Close False
End Sub

またFSO（FileSystemObject）を使って１行ずつデータを読み込み、","をタブに変換してクリップボード経由でセルに貼り付ける方法もあります。こちらはコードは上げませんが、慣れてきたら調べてみたら良いと思います

お礼

ご回答ありがとうございました。
試してみたいと思います。
また、なにかありましたらよろしくお願い致します。