I got a code that merge two excel files to into one file. without save.
I select first with a dialogWindow a SourceFolder, I select then a TargetFolder with another dialogWindow.
I want instead of have two dialogwindows use One, to loop through a whole folder.
the filenames in the folder have this pattern see below: but the names can be almost anything, there is one thing that make them as a pair.
Se follow Filenames so see the pattern:
TEST_Translation2_jeeves_sv.xls
TEST_Translation2_jeeves_sv_NoTrans.xls
TEST_Translation2_UCHPResourcesCommon_de.xls
TEST_Translation2_UCHPResourcesCommon_de_NoTrans.xls
TEST_Translation2_creditDocument_ar.xls
TEST_Translation2_creditDocument_ar_NoTrans.xls
if the select the first file of the examples:
I want now to merge the sheet from "TEST_Translation2_jeeves_sv_NoTrans.xls" to "TEST_Translation2_jeeves_sv.xls" and save the file (TEST_Translation2_jeeves_sv.xls)
the script need to loop through a whole folder.
Could someone help me to modify my code?
Sub Combinles_Step1()
'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select Source folder"
If .Show = -1 Then
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
FolderLocation = .SelectedItems(1)
'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
'Create a new workbook
Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(FolderLocation & "\*.xls", vbNormal)
'Iterate for each file in folder
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set WorkbookSource = Workbooks.Open(Filename:=FolderLocation & "\" & strFilename)
Set WorksheetSource = WorkbookSource.Worksheets(1)
WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
WorkbookSource.Close False
strFilename = Dir()
Loop
WorkbookDestination.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End With
End Sub
Thank you in advance