How to modify code to update multiple workbook files which has the same format but different data?

[Corried]

Hello excel programmers.

I don't know if you can help me. Yet again, if you are comfortable to view the files below for testing.

This is my concerned. I have a code for each of my workbook files below. (I have over 100 workbooks which has the same codes and excel layout, but different data).

The code copies data from each cell and paste it into each worksheet, from the "News" tab...

The code works great.

Here is the code for each individual workbook:

Sub EXPORTONGLETS()
'VALID DECLARATION
    Dim NOMFEUILLE As String    'NAME VARIABLE FOR THE HOME TAB
    Dim NBLIGNES As Long  ' VARIBLE NUMBER OF LINES PROVIDED IN NEWS
    Dim LADATE As Date   ' EXPORT DATE INDICATION
    Dim t$
 
    With Worksheets("News")
        NBLIGNES = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
 
    LADATE = Format(CDate(Now), "dd/MM/yyyy")
 
    'WE LAUNCH A LOOP ON ALL THE LINES OF THE NEWS TAB FROM LINE 2 TO THE END
    For i = 3 To NBLIGNES
        t = GetHash(Worksheets("News").Range("B" & i).Value)    'GetHash
        'RECOVER THE NAME OF THE TAB INDICATED IN COLUMN (A) OF NEWS
        NOMFEUILLE = Worksheets("News").Range("A" & i)
        If IsError(Application.Match(t, Worksheets(NOMFEUILLE).Columns(3), 0)) Then    'check Hash
            'WITH THE DESTINATION SHEET, WE INSERT A LINE IN LINE 3 THEN WE INFORM
            With Sheets(NOMFEUILLE)
                .Rows("2:2").Insert Shift:=xlDown
                .Range("A3").Value = LADATE
                'Worksheets(NOMFEUILLE).Range("B3").Value = Worksheets("News").Range("B" & i).Value
                Worksheets("News").Range("B" & i).Copy .Range("B3")
                .Range("C3").Value = t
                .Rows("3:3").EntireRow.AutoFit
            End With
        End If
        'GO TO THE NEXT NEWS VALUE
    Next i
 
    With Sheets("News").Activate
    End With
 
End Sub
 
 
Function GetHash(ByVal txt$) As String
    Dim oUTF8, oMD5, abyt, i&, k&, hi&, lo&, chHi$, chLo$
    Set oUTF8 = CreateObject("System.Text.UTF8Encoding")
    Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    abyt = oMD5.ComputeHash_2(oUTF8.GetBytes_4(txt$))
    For i = 1 To LenB(abyt)
        k = AscB(MidB(abyt, i, 1))
        lo = k Mod 16: hi = (k - lo) / 16
        If hi > 9 Then chHi = Chr(Asc("a") + hi - 10) Else chHi = Chr(Asc("0") + hi)
        If lo > 9 Then chLo = Chr(Asc("a") + lo - 10) Else chLo = Chr(Asc("0") + lo)
        GetHash = GetHash & chHi & chLo
    Next
    Set oUTF8 = Nothing: Set oMD5 = Nothing
End Function

The problem I am having is this:

I have a next code below.

The code automatically open close and save workbook and open a next workbook and do the same process until all of the workbooks in the folder are updated.

The question is:

How can I modify the code above to update all the workbooks in the file, like the code below?
How can I do that? What do you recommend me to do?

Thanks in advance

Option Explicit


Sub RunOnAllFilesInFolder()
  Dim folderName$, fileName$, f&, ARR, fls$(), fDialog As Object
  Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
  With fDialog              ' Select folder in which all files are stored
    .Title = "Select a folder": .InitialFileName = ThisWorkbook.Path
    If .Show = -1 Then folderName = .SelectedItems(1) Else Exit Sub
  End With
  fileName = Dir(folderName & Application.PathSeparator & "*.xls*")
  Do While fileName <> ""
    f = f + 1: ReDim Preserve fls(f): fls(f) = fileName: fileName = Dir
  Loop
  Application.ScreenUpdating = False
  ARR = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2)).Value
  For f = 1 To f
    UpDateWB folderName & Application.PathSeparator & fls(f), ARR
  Next
  Application.ScreenUpdating = True: Application.StatusBar = ""
  MsgBox "Completed executing macro on all workbooks"
End Sub


Sub UpDateWB(fn$, ARR)
Dim z&, M&, wb As Workbook, ARR2, i&, LR2 &
  Set wb = Workbooks.Open(fn)
  For z = 3 To wb.Worksheets.Count
    With wb.Worksheets(z)
      LR2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1:  M = 1
      ReDim ARR2(1 To UBound(ARR), 1 To 2)
      For i = 1 To UBound(ARR)
        If .Name = ARR(i, 1) And ARR(i, 2) <> "" Then
          ARR2(M, 1) = Now(): ARR2(M, 2) = ARR(i, 2): M = M + 1
        End If
      Next
      .Cells(LR2, 1).Resize(UBound(ARR), 2).Value = ARR2
    End With
  Next
  wb.Save: wb.Close
End Sub

Please view the file below using the link:

Desktop.rar

drive.google.com