"複数ファイル結合"

"出力例"

複数のtxtファイルを開き、一つのエクセルファイルとして出力する。(26以上のファイルも可)

"サンプルマクロ01"

"ヒント・解説01"

Public Sub multifileopen01()

Dim listfilename As String
Dim i As Integer, startrow As Integer, fn As Integer
Dim TXTFilePath As Variant, FullFileName As Variant, FileName As Variant, maxrow As Variant
Dim s1 As Variant, s2 As Variant

On Error GoTo ErrHandle 'エラー発生時にErrHandle実行

TXTFilePath = Application.GetOpenFilename(FileFilter:="TXTファイル(*.TXT),*.TXT", Title:="Crystal Markファイルを開いて下さい", MultiSelect:=True) '複数ファイル読み込み
If IsArray(TXTFilePath) = False Then Exit Sub

startrow = 5 ' txtファイル読み込みの開始行
fn = UBound(TXTFilePath) 'ファイル数

ReDim Preserve TXTFilePath(fn)
ReDim FullFileName(fn) As Variant, FileName(fn) As Variant

Workbooks.Add '新規ワークブック追加
listfilename = ActiveWorkbook.Name  'ワークブックの名前取得

For i = 1 To fn

    FullFileName(i) = Mid(TXTFilePath(i - 1), InStrRev(TXTFilePath(i - 1), "\") + 1) '*.txt（ファイル名+拡張子)取得
    FileName(i) = Left(FullFileName(i), InStrRev(FullFileName(i), ".") - 1) '*(ファイル名)取得

    Workbooks.OpenText FileName:=TXTFilePath(i - 1), _
    Origin:=932, startrow:=startrow, DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True 'txtファイルを開く
    
    ReDim maxrow(fn)
    maxrow(i) = ActiveSheet.UsedRange.Rows.Count
    Set s1 = Workbooks(listfilename).Worksheets(1): Set s2 = Workbooks(FullFileName(i)).Worksheets(1)
    
    s1.Cells(1, i).Value = FileName(i) '1行i列目にtxtのファイル名を表示
    s1.Range(s1.Cells(2, i), s1.Cells(maxrow(i) + 1, i)).Value _
     = s2.Range(s2.Cells(1, 1), s2.Cells(maxrow(i), 1)).Value
    
    Set s1 = Nothing: Set s2 = Nothing
    Workbooks(FullFileName(i)).Close

Next i

MsgBox "完了しました"

Exit Sub

ErrHandle:

    MsgBox "キャンセルしました"
    
End Sub

	

   1.Application.GetOpenFilenameメソッドを使ってフルファイルパスを取得する。

  2.フルファイルパスからファイルネームを抽出する。

  3.取得したデータをもとに複数ファイルを開く。