Excel Forum

Code: Select all

Private Sub CommandButton1_Click()
    Dim lr As Long, lc As Long
    Dim sh As Worksheet, wb As Workbook
    Dim fileName As String, dataPath As String
    Dim tgSh As Worksheet, tl As Long
    
    Set tgSh = ThisWorkbook.Worksheets(1)
    If TextBox1.Value = "" Then
         MsgBox "**Input some value**"
         TextBox1.SetFocus
         Exit Sub
    End If
    dataPath = (TextBox1.Value) & "\"
    fileName = Dir(dataPath & "*.xlsx")
        Unload Me
    masRow = 1
    '-------- Loop open file -------------
    tl = 0
    Do While fileName <> ""
        'Open workbook
        Set wb = Workbooks.Open(fileName:=dataPath & fileName, ReadOnly:=True)

        '---------------------Loop sheet --------------------------------------
        For Each sh In wb.Sheets
            sh.Columns.EntireColumn.Hidden = False
            sh.Rows.EntireRow.Hidden = False
            If sh.FilterMode = True Then
                sh.ShowAllData
            End If
            With sh
                lr = .Range("i" & .Rows.Count).End(xlUp).Row
                lc = .Cells(5, .Columns.Count).End(xlToLeft).Column
            End With
            tgSh.Range("a1").Offset(tl, 0).Resize(lr, lc).Value = _
                sh.Range("a1").Resize(lr, lc).Value
            tl = tl + lr
        Next sh

        wb.Close False

        ' Call dir again ..
        fileName = Dir()
    Loop

End Sub