Merge excel files as per File Names in 2 worksheet

[Abhijeet]

Hi

I have macro Data pull as per sheet names but i want few files data pull in One sheet & few files data in Second sheet. File names are like this 01.xxxxx.xls or .xlsx in every file name starting with the Number so i want 01 & 02 files data i want pull in Sheet1 & 03 & 04 files data i want pull in Sheet2 is this possible please tell me how to do this

Option Explicit

Option Compare Text

Sub mergeFiles()

' DECLARE ALL VARIABLES AND ARRAYS

Dim fldpath As Variant
Dim fld, fil, FSO As Object
Dim WKB As Workbook
Dim wks As Worksheet
Dim shtnames()
Dim Paste
Dim j As Long, w As Long
Dim stcol As String, lastcol As String, fc As Integer
stcol = "A" ' Change the starting column of ur data

lastcol = "Z" ' Change the ending column of ur data

Dim i As Long

Set fldpath = Application.FileDialog(msoFileDialogFilePicker)
With fldpath
    .Title = "Choose the folder"
    .AllowMultiSelect = True
    .Show
    fc = .SelectedItems.Count
      If Not fc > 0 Then MsgBox "Folder Not Selected": Exit Sub
End With

' change sheet names here

shtnames = Array("Travel Qry", "Travel Confirmation", "Salary Qry", "Salary Confirmation", "Absence") '\ add or remove sheets

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.StatusBar = True
Application.StatusBar = "Please wait till Macro merge all the files"

For i = 1 To fc

Set WKB = Workbooks.Open(fldpath.SelectedItems(i))
    For j = LBound(shtnames) To UBound(shtnames)
        For Each wks In WKB.Sheets
            If wks.Name = shtnames(j) Then
                w = WKB.Sheets(shtnames(j)).Range("a65356").End(xlUp).Row
                    If w >= 2 Then
                        WKB.Sheets(shtnames(j)).Range(stcol & "2:" & lastcol & w).Copy _
                            Destination:=ThisWorkbook.Sheets(shtnames(j)).Range("a65356").End(xlUp).Offset(1, 0)
                    End If
                Exit For
            End If
        Next
    Next
WKB.Close

Next

MsgBox "Done"
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub