Hi
Untested.
Code:
Option Explicit
Sub kTest()
Dim SourceFolder As String
Dim wbkSource As Workbook
Dim wbkDest As Workbook
Dim FName As String
Dim rngSource As Range
Dim wksDest As Worksheet
SourceFolder = "C:\Test" '<<< adjust the folder
If Right$(SourceFolder, 1) <> "\" Then SourceFolder = SourceFolder & "\"
FName = Dir(SourceFolder & "*.xls*")
Set wbkDest = ThisWorkbook
Application.ScreenUpdating = 0
Set wksDest = wbkDest.Worksheets(wbkDest.Worksheets.Count)
Do While Not FName = vbNullString
If Not FName = wbkDest.Name Then
Set wbkSource = Workbooks.Open(SourceFolder & FName, 0)
Set rngSource = wbkSource.Worksheets(1).Range("a1").CurrentRegion
Set wksDest = wbkDest.Worksheets.Add(, wksDest)
rngSource.Copy wksDest.Range("a1")
wksDest.Name = FName
End If
wbkSource.Close 0
Set wbkSource = Nothing
FName = Dir()
Loop
Application.ScreenUpdating = 1
End Sub
Bookmarks