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