Automatically combine multiple sheets

[assa]

I looking for help to adjust the below code for merging multiple workbooks into one. Currently, a userform is activated when the sheet opens. The user is then asked to update the sheets, which technically means that multiple workbooks (each containing two sheets) are merged into one. When the user presses the "update" button, he/she is now asked to locate the folder in which the files are saved. However, to make it easier for the user, I would like the update (merge of data) to happen automatically, when the user presses the "update" button. That is, it should automatically take all .xls files in the folder and combine them into one. Does anyone know this can be done? Any help is much appreciated.


Private Sub CommandButton1_Click()

Dim strFldrPath As String
Dim strCurrentFile As String
Dim wbDest As Workbook
Dim wb As Workbook
Dim WS As Worksheet
Dim arrWS() As String
Dim i As Long

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "C:\Documents and Settings\BA3635\Desktop\New Price lists\Test"
.Show
On Error Resume Next: strFldrPath = .SelectedItems(1) & "\"
End With

If strFldrPath = vbNullString Then Exit Sub

strCurrentFile = Dir(strFldrPath & "*.xls*")
Set wbDest = ActiveWorkbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Delete the sheets if they exist
Application.DisplayAlerts = False
On Error Resume Next

For Each WS In ActiveWorkbook.Worksheets
If WS.name <> "Start" And WS.name <> "Instructions" And WS.name <> "Products" And WS.name <> "Horisontal view" And WS.name <> "ProductsOutput" Then
WS.Delete
End If
Next

On Error GoTo 0
Application.DisplayAlerts = True

While strCurrentFile <> vbNullString
If strCurrentFile <> wbDest.name Then
Set wb = Workbooks.Open(strFldrPath & strCurrentFile)
ReDim arrWS(1 To wb.Sheets.Count)
i = 0
For Each WS In wb.Sheets
i = i + 1
arrWS(i) = WS.name
Next WS
wb.Sheets(arrWS).Copy After:=wbDest.Sheets(wbDest.Sheets.Count)
wb.Close False
End If
strCurrentFile = Dir
Wend

Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Return to sheet1 when update is complete
Sheets("Start").Select

Unload Me

End Sub

[GreenDR]

Try the below to work with files


Dim fs, f, fc, fx
Dim rpt

Set fs = CreateObject("Scripting.FileSystemObject") 'create a filesystem object
Set f = fs.GetFolder(strFldrPath) 'create a folder object
Set fc = f.Files 'create an object for files
Application.ScreenUpdating = False
Workbooks.Add 'create a new workbook
rpt = ActiveWorkbook.Name 'get the name of the new workbook
For Each fx In fc 'for each file in the folder, do the below
Workbooks.Open fx 'open file
'merging criteria goes here
Workbooks(fx.Name).Close False 'close file
Next
Workbooks(rpt).SaveAs Filename:= "give the path and filename with extension here"
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks( merged file name ).Close
Application.ScreenUpdating = True