ファルダに有るすべての拡張子TXT.ファイルをExcel1個にまとめる

質問

VBAでフォルダを指定した後、そこのファルダに有るすべての拡張子TXT.ファイル（中身はCSVファイル）
を新しいExcelを1個開いてまとめるマクロを何方か教えてください。
下記だとエクセルが多数開いてしまいます。
（TXT.ファイル1個＝Excelのシート1枚）
--------------------------------------------------------
Sub ffff()
myPName = Application.GetOpenFilename("データ（*.TXT;*.DAT）,*.TXT;*.DAT")
If myPName = "False" Then Exit Sub

myKAKUCHOSI = Right(myPName, 4)
myPATHNAME = CurDir
myLName = Dir(myPATHNAME & "\" & "*" & myKAKUCHOSI)

Do While myLName <> ""
Workbooks.OpenText Filename:=myPATHNAME & "\" & myLName, DataType:=xlDelimited, Tab:=True, Comma:=True, Space:=True
myLName = Dir()
Loop
End Sub

回答No.4

nekotaru · ベストアンサー

こんにちわです。

この行を
wb.ActiveSheet.Copy before:=wb_New.Sheets(1)

以下の行に差し替えてくださいー
wb.ActiveSheet.Copy after:=wb_New.Sheets(wb_New.Worksheets.Count)

これでうまくいくと思いますー

お礼

nekotaruさん、3回も回答ありがとう御座いました。
完璧な物が出来ました、今回は本当にありがとう御座いました。

回答No.3

nekotaru

こんな感じでいかがでしょう？

Sub test()

Dim myPName As Variant

myPName = Application.GetOpenFilename("データ（*.TXT;*.DAT）,*.TXT;*.DAT")
If myPName = "False" Then Exit Sub

Dim wb_New As Workbook

Set wb_New = Workbooks.Add

Dim myKAKUCHOSI As String
Dim myPATHNAME As String
Dim myLName As String
Dim wb As Workbook

myKAKUCHOSI = Right(myPName, 4)
myPATHNAME = CurDir
myLName = Dir(myPATHNAME & "\" & "*" & myKAKUCHOSI)

Do While myLName <> ""
Workbooks.OpenText Filename:=myPATHNAME & "\" & myLName, DataType:=xlDelimited, Tab:=True, Comma:=True, Space:=True

Set wb = ActiveWorkbook
wb.ActiveSheet.Copy before:=wb_New.Sheets(1)

wb.Close savechanges:=False

myLName = Dir()
Loop

'
'不要なシートを削除
'
Dim ws As Worksheet

Application.DisplayAlerts = False
For Each ws In wb_New.Worksheets
If InStr(ws.Name, "Sheet") > 0 Then
ws.Delete
End If
Next
Application.DisplayAlerts = True

End Sub

補足

nekotaruさんありがとう御座いました。
早速実行しました、ほぼイメージどうりの物が出来ました。
もし良ければもう一つ教えて欲しいのですが、シート名の並び方が現在は左から大きい順に並んでいますが逆の左-小、右-大のようにしたいのですが可能でしょうか。
何度も質問して済みませんが、時間がある時で結構ですので宜しくお願いします。

回答No.2

imogasi

>新しいExcelを1個開いてまとめるマクロを何方か教えてください
フォルダのファイル１つーー＞Sheet１つ
づつにするのか、
全てのファイルのデータを１つのSheetの下の方へ継ぎ足してゆくのか書かないと、質問の趣旨が不明確です。

補足

マクロ実行時に指定したフォルダに10個TXTファイルが有れば、最後にはマクロが書いてあるExcelファイルとマクロによって開かれたExcelファイル（シートは10個）になっている状態が希望です。

回答No.1

nekotaru

こんな感じでいかがでしょう？

Sub ffff()

Dim myPName As Variant
Dim myKAKUCHOSI As String
Dim myPATHNAME As String
Dim myLName As String
Dim wb As Workbook

myPName = Application.GetOpenFilename("データ（*.TXT;*.DAT）,*.TXT;*.DAT")
If myPName = "False" Then Exit Sub

myKAKUCHOSI = Right(myPName, 4)
myPATHNAME = CurDir
myLName = Dir(myPATHNAME & "\" & "*" & myKAKUCHOSI)

Do While myLName <> ""
Workbooks.OpenText Filename:=myPATHNAME & "\" & myLName, DataType:=xlDelimited, Tab:=True, Comma:=True, Space:=True

Set wb = ActiveWorkbook
wb.ActiveSheet.Copy before:=ThisWorkbook.Sheets(1)

wb.Close savechanges:=False

myLName = Dir()
Loop
End Sub

お礼

ご回答のお礼が遅れまして、大変失礼致しました。
今、Excelが使えるPCが無いので月曜日に試したいと思います。
今回は回答ありがとうございました。

補足

nekotaruさんありがとう御座いました。
早速実行しましたが、現在だとマクロが書いてあるファイルにシートが足されてしまいますが出来れば、マクロ実行時に新しいExcelファイルが開き、マクロで指定したフォルダに10個TXTファイルが有れば、最後にはマクロが書いてあるExcelファイルとマクロによって開かれたExcelファイル（シートは10個）になっている状態が希望です。
宜しくお願いします。