create sheets based on extensions files and copy to each months

I will work on that but both methods do that.

For what it is worth, 2 other methods can accomplish the sample goal. For one, press or click a cell to trigger a worksheet selectionchange event. For a mouse doubleclick method, a worksheet beforedoubleclick event. These methods have trade-offs like any method.

Here is your one code line replacement solution:

Code:

---

'ws.Cells(ws.Rows.Count, mn + 1).End(xlUp).Offset(1) = fbn
ws.Hyperlinks.Add ws.Cells(ws.Rows.Count, mn + 1).End(xlUp).Offset(1), f.Path, , , fbn

---

it doesn't add any hyperlink and doesn't gives me any error

Works fine for me. I "almost" never post code that I have not tested to some degree.

I can only guess that you already have the file basenames so it worked as designed and did not add another. Delete your existing data in backup copy of the file and run again...

nothing changes :(

it successes :yes
thanks for every thing

Then I can help no further as it works for me.

My last run used this. It uses the mn+1 that I discussed earlier. I also attached your original workbook with my macros. I like copy paste from files rather than forums as they don't post tab characters.

Code:

---

Sub Main4()
  Dim pf As String, sfs, sfp
  'Tools > References > Microsoft Scripting Runtime
  Dim fso As FileSystemObject, sf As Scripting.Folder, f As Scripting.File
  Dim ws As Worksheet, fr As Range
  Dim mn As String, fbn As String
 
  'Parent Folder
  pf = "d:\myfiles\t"
 
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
 
  Set fso = New FileSystemObject
 
  'Array with Subfolder paths.
  'http://www.vbaexpress.com/forum/showthread.php?58579-get-file-paths-based-on-name-criteria-from-folder
  sfs = aFFs(pf, "/ad", True)
 
  'No error check for subfolder paths put into sfs. At least one subfolder is assumed.
  For Each sfp In sfs
    Set sf = fso.GetFolder(sfp)
    'Copy Template worksheet to new worksheet and with subfolder name.
    If Not WorkSheetExists(sf.ShortName) Then
      Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
      Worksheets(Worksheets.Count).Name = sf.ShortName
    End If
    'Set worksheet for input: Assumes that each subfolder name has a worksheet name.
    Set ws = Worksheets(sf.ShortName) 'e.g. CSV, XLS, XLSM, etc.
    For Each f In sf.Files
      'Month number from file's date created.
      'mn = Month(f.DateCreated)
      'Month number from file's date modified.
      'mn = Month(f.DateLastModified)
      'Month number from file's oldest date created or date modified.
      mn = Month(WorksheetFunction.Min(f.DateCreated, f.DateLastModified))
      'File's basename
      fbn = fso.GetBaseName(f.Name)
      'Find fbn in month name's column
      Set fr = ws.Columns(mn + 1).Find(fbn)
      If fr Is Nothing Then
        'ws.Cells(ws.Rows.Count, mn + 1).End(xlUp).Offset(1) = fbn
        ws.Hyperlinks.Add ws.Cells(ws.Rows.Count, mn + 1).End(xlUp).Offset(1), f.Path, , , fbn
      End If
    Next f
    ws.UsedRange.Columns.AutoFit
  Next sfp
 
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub

---

file is a great more again thanks for provide me the astonishing solution
best regards,
Abdelfattah