Excel Forum

Code: Select all

Private Sub CommandButton1_Click()

    Dim strPath As Variant, i As Integer
    Dim fName As String, nb As Workbook
    Dim tb As Workbook
    
    Set tb = ThisWorkbook
    strPath = Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
    
    For i = 1 To UBound(strPath)
        Set nb = Workbooks.Open(strPath(i))
        With nb.Worksheets(1)
            .Range("a1").Offset(0, .UsedRange.Columns.Count) _
                .Resize(.UsedRange.Rows.Count - 1, 1).Value = .Name
            .UsedRange.Offset(0, 0).Copy
        End With
        With tb.Sheets(1)
            .Range("a" & .Rows.Count).End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues
        End With
        Cells.EntireColumn.AutoFit
    Columns("A:AS").EntireColumn.AutoFit
        Application.CutCopyMode = False
        nb.Close False
    Next i

    'Selection.Cut
    'Sheets.Add After:=ActiveSheet
    'ActiveSheet.Paste
End Sub