copy all workbooks in a folder to a different workbook

[prajesh]

hi all,
i was handed-over a VBA code which copies the 1st sheet of all workbooks in a folder to a different workbook.
there are a few minor changes i wanted on this code.

1) The folder also contains the workbook to which the other workbooks are to be copied. Quite obviously, we have to open the destination workbook and run the code to copy those files to this workbook. But what happens is, at the end an error message appears saying that the "destination" folder couldn't be opened. So i was trying to edit the code so that it wouldn't not try to open the 'destination" workbook.

2) After all sheets have been copied, i want the original sheet to be active one and not the sheet which have been copied last.

My code-

Option Explicit
 
Sub MergeData()
    Dim FSO         As Object '<-- FileSystemObject
    Dim fsoFol      As Object '<-- Folder
    Dim fsoFil      As Object '<-- File
    Dim WB          As Workbook
    Dim wks         As Worksheet
    Dim ShNames()   As String
    Dim Path        As String
    Dim PathNew     As String
    Dim i           As Long
     
    With ThisWorkbook
         
        Path = .Path & "\"
         
        Application.ScreenUpdating = False
         
        If .Worksheets.Count > 1 Then
            ReDim ShNames(1 To .Worksheets.Count)
            For i = 1 To .Worksheets.Count
                ShNames(i) = .Worksheets(i).name
            Next
            .Worksheets.Add After:=.Worksheets(1), Type:=xlWorksheet
            Application.DisplayAlerts = False
            Application.DisplayAlerts = True
        End If
         
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set fsoFol = FSO.GetFolder(.Path & "\")
         
        For Each fsoFil In fsoFol.Files
             
            If Mid(fsoFil.name, InStrRev(fsoFil.name, ".") + 1) Like "xls*" _
            And Not fsoFil.name = .name Then
                 
                Set WB = Workbooks.Open(fsoFil.Path, False)
                WB.Worksheets(1).Copy After:=.Worksheets(.Worksheets.Count)
                 
                .Worksheets(.Worksheets.Count).name = _
                Left(Left(fsoFil.name, InStrRev(fsoFil.name, ".") - 1), 31)
                 
                WB.Close False
            End If
        Next
                        
        Application.DisplayAlerts = False
        Application.DisplayAlerts = True
         
        Application.ScreenUpdating = True
         
        Set WB = Nothing
         
        If MsgBox("Save Me now?...", _
        vbQuestion Or vbYesNo Or vbDefaultButton1, _
        "You wanna save?") = vbYes Then
            .Save
        End If
    End With
    
   

End Sub

thanks in advance.