#1
|
|||
|
|||
Merge files if filenames match
Hi All,
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.x ls 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? 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 |
#2
|
||||
|
||||
There are many examples of merging at this site. Maybe the code will help.
__________________
Did you know you can thank someone who helped you? Click on the tiny scale in the right upper hand corner of your helper's post |
Tags |
compare, filename |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Insert images with incrementallly-numbered filenames | mqx | Word VBA | 4 | 11-13-2013 11:22 AM |
Merge data files | jmhultin | Outlook | 2 | 08-09-2013 02:01 PM |
Merge Outlook Files | Irvinraw | Outlook | 1 | 09-23-2012 06:25 PM |
Sequential Default Filenames | dude10321 | Word | 0 | 08-05-2011 02:54 PM |
Color code filenames in explorer | terence_laoshi | Office | 0 | 01-18-2011 11:01 PM |