複数のテキストファイルを1つのExcelシートにまとめる

Question

同じフォーマットとカラムを持つ27個のtxtファイルがありますが、これらをすべて1つのExcelシートに追加します。以前のスレッドを確認しましたが、txtファイルを別のシートにインポートするのに役立つ以下のコードしか見つかりませんでした。ただし、これらの別々のシートをシートに追加して、すべてのデータを追加したいと考えています。

Sub Test() 
'UpdatebyExtendoffice6/7/2016 
    Dim xWb As Workbook 
    Dim xToBook As Workbook 
    Dim xStrPath As String 
    Dim xFileDialog As FileDialog 
    Dim xFile As String 
    Dim xFiles As New Collection 
    Dim I As Long 
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) 
    xFileDialog.AllowMultiSelect = False 
    xFileDialog.Title = "Select a folder [Vendor_data_25DEC]" 
    If xFileDialog.Show = -1 Then 
     xStrPath = xFileDialog.SelectedItems(1) 
    End If 
    If xStrPath = "" Then Exit Sub 
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\" 
    xFile = Dir(xStrPath) 
    'xFile = Dir(xStrPath & "*.txt") 'this is the original version that you can amend according to file extension 
    If xFile = "" Then 
     MsgBox "No files found", vbInformation, "Vendor_data_25DEC" 
     Exit Sub 
    End If 
    Do While xFile <> "" 
     xFiles.Add xFile, xFile 
     xFile = Dir() 
    Loop 
    Set xToBook = ThisWorkbook 
    If xFiles.Count > 0 Then 
     For I = 1 To xFiles.Count 
      Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I)) 
      xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count) 
      On Error Resume Next 
      ActiveSheet.Name = xWb.Name 
      On Error GoTo 0 
      xWb.Close False 
     Next 
    End If 
End Sub 

---

私はすぐに単一のシートに別々のシート内のデータを結合するために、VBAでこれを行う方法がわからないです。私はExcelの統合機能を知っていますが、手作業の手順も多く含まれているので、私はより高速で自動化されたソリューションを模索しています。どんな助けも大歓迎です。 ありがとうございます。

Answer 1

Sub Combiner() 

    Dim strTextFilePath$, strFolder$ 
    Dim wksTarget As Worksheet 
    Dim wksSource As Worksheet 
    Dim x As Long 

    Set wksTarget = Sheets.Add() 
    strFolder = "c:\Temp\test\" 
    strTextFilePath = Dir(strFolder) 

    While Len(strTextFilePath) > 0 
     '// "x" variable is just a counter. 
     '// It's purpose is to track whether the iteration is first or not. 
     '// If iteration is first (x=1), then we include header (zero offset down), 
     '// otherwise - we make an offset (1 row offset down). 
     x = x + 1 
     Set wksSource = Workbooks.Open(strFolder & strTextFilePath).Sheets(1) 
     With wksTarget 
      wksSource.Range("A1").CurrentRegion.Offset(IIf(x = 1, 0, 1)).Copy _ 
         .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 
     End With 
     wksSource.Parent.Close False 
     strTextFilePath = Dir() 
    Wend 

    MsgBox "Well done!", vbInformation 

End Sub