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:
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
Please view the file below using the link:
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:
VBA Code:
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
VBA Code:
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