Excel macro to insert a value into mutiple excel files - excel

Question

hope you're fine,
i want a macro to read multiple excel files and insert a value in specific cell ( for example C3 or A1 or any cell declared in the code)
here firs image of my code, just a button
and here is my code:
Sub InsertValueInCell()
Range("C3").Value = _
InputBox(Prompt:="Enter the value you want to insert.")
End Sub
this code give me this result right now, it's just insert the data in the actual workbook :
TEST-1
TEST-2
Thanks in advance to help me to complete the code cause i want the code to read multiple excel files and after that i can insert a value in specific cell for all thos excel files.
Thanks in advance
Have a good day All
here is my code for the moment:
Sub InsertValueInCell()
Range("C3").Value = _
InputBox(Prompt:="Enter the value you want to insert.")
End Sub
this code give me this result right now, it's just insert the data in the actual workbook :
TEST-1
TEST-2
Thanks in advance to help me to complete the code cause i want the code to read multiple excel files and after that i can insert a value in specific cell for all those excel files (for example i want to insert a value in the C3 cell for all those excel files).
Thanks in advance
Have a good day All

Answer 1

This should work for you:
Option Explicit 'Must be at very top of module, before any procedures.
'Possibly the most important line in any code - forces you to declare your variables.
Public Sub AddValueToSheet()
On Error GoTo ERROR_HANDLER
'The Sheet to changed.
Dim SheetName As String
SheetName = "Sheet1"
'Get a collection of files within the folder.
Dim FileCollection As Collection
Set FileCollection = New Collection
Set FileCollection = EnumerateFiles("<folder path>\") 'Don't forget the final backslash.
Dim ValueToEnter As String 'or whatever type you're trying to enter.
ValueToEnter = InputBox("Enter the value you want to insert")
'Look at each item in the collection.
Dim wrkBkPath As Variant
For Each wrkBkPath In FileCollection
'Open the workbook.
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open(wrkBkPath)
'Check if the sheet exists.
'Add the value if it does, add the file name to the MissingSheetList string if it doesn't.
Dim MissingSheetList As String
If SheetExists(wrkBk, SheetName) Then
wrkBk.Worksheets(SheetName).Range("A1") = ValueToEnter
Else
MissingSheetList = MissingSheetList & wrkBk.Name & vbCrLf
End If
'Save and close.
wrkBk.Close SaveChanges:=True
Next wrkBkPath
'Display missing sheet list message if there's any.
If MissingSheetList <> "" Then
MsgBox "The files were missing " & SheetName & vbCr & vbCr & MissingSheetList, vbInformation + vbOKOnly
End If
Exit Sub
'If an error occurs code skips to this section.
ERROR_HANDLER:
Dim ErrMsg As String
ErrMsg = "AddValueToSheet()" & vbCr & Err.Description
'Add error handling code.
Select Case Err.Number
Case Else
End Select
End Sub
'Check if a sheet exists by trying to set a reference to it.
Private Function SheetExists(wrkBk As Workbook, SheetName As String) As Boolean
On Error Resume Next
Dim ShtRef As Worksheet
Set ShtRef = wrkBk.Worksheets(SheetName)
SheetExists = (Err.Number = 0) 'Was an error returned? True or False.
On Error GoTo 0
End Function
'Returns all xls* files from the path supplied by sDirectory.
'Each file path is added to the FilePaths collection.
Private Function EnumerateFiles(ByVal sDirectory As String) As Collection
On Error GoTo ERROR_HANDLER
'You can remove StatusBar lines if you want - code might run too fast to see anyway.
Application.StatusBar = "Collating files: " & sDirectory 'Update status bar.
Dim cTemp As Collection
Set cTemp = New Collection
Dim sTemp As String
sTemp = Dir$(sDirectory & "*.xls*")
Do While Len(sTemp) > 0
cTemp.Add sDirectory & sTemp
sTemp = Dir$
Loop
Set EnumerateFiles = cTemp
Application.StatusBar = False 'Reset status bar.
Exit Function
'If an error occurs code skips to this section.
ERROR_HANDLER:
Dim ErrMsg As String
ErrMsg = "EnumerateFiles()" & vbCr & Err.Description
'Add error handling code.
Select Case Err.Number
Case Else
End Select
End Function