Merge files if filenames match a certain value

[dapeamel]

Hello all,

I have made following code that loops through each file in a folder I select.

when the loop finds a file contains "*NoTrans.xls"

a filename can be example:

test_en_NoTrans.xls


I have a filter that removes "*NoTrans.xls"

so result:

test_en.xls

I need to to make a function to open the file also merging the file into the file

I looping with


test_en_noTrans.xls

Could someone help me?

See code below:

Sub files()
Application.DisplayAlerts = False

Dim wb As Workbook
Dim MyPath As String
Dim MyFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        MyPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  MyPath = MyPath
  If MyPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*NoTrans.xls"

'Target Path with Ending Extention
  MyFile = Dir(MyPath & myExtension)

'Loop through each Excel file in folder
  Do While MyFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=MyPath & MyFile)
    
    'gör något
    
    
MyFileNoTransOpen = ActiveWorkbook.Name
myActFilePath = Application.ActiveWorkbook.Path

myOpenNoTrans = Left(MyFileNoTransOpen, (InStrRev(MyFileNoTransOpen, ".", -1, vbTextCompare) - 9))



myLangFile = myOpenNoTrans & ".xls"


MsgBox myOpenNoTrans

MsgBox myLangFile

MsgBox myActFilePath

     
    ' MsgBox ActiveWorkbook.Name
     
    
    'Save and Close Workbook
      wb.Close savechanges:=True

    'Get next file name
      MyFile = Dir
  Loop

'Message Box when tasks are completed
 ' MsgBox "Nu är alla celler på Rad 1 Dolda!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub