Snasui Excel Forum

Code: Select all

Option Explicit
Private Sub Button1_Click()
    Dim directory As String, fileName As String
    Dim sheet As Worksheet, j As Integer
    Dim tempBook As Workbook, thsBook As Workbook
    Application.ScreenUpdating = False
    directory = "d:\excel\term1\"
    fileName = Dir(directory & "*.xl??")
    Set thsBook = ThisWorkbook
    j = 3
    Do While fileName <> ""
        Set tempBook = Workbooks.Open(directory & fileName)
        thsBook.Sheets(1).Cells(4, j) = tempBook.Name
        thsBook.Worksheets(1).Cells(6, j).Resize(5, 1).Value = _
            tempBook.Sheets(3).Range("e3:e7").Value
        j = j + 1
        tempBook.Close False
        fileName = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub