Open Workbooks Loop through all Sheets - excel

Question

I am trying to run a command to open all workbooks from a query. Once open I am looking to edit the same cells in each tab for each workbook. The code below, works to open, and edit each workbook in the query when trying to update to run through each active sheet in the workbooks it will only update the first sheet. The second set is what I have tried to have it loop through each sheet.
Open and update the first active sheet in each workbook
Sub UpdateMetrics()
Dim wb As Workbook
For Each Cell In Selection
Set wb = Workbooks.Open(Cell.Value)
Range("A1").Value = "Test"
wb.Save
wb.Close
Next
End Sub
Loop through each sheet:
Sub UpdateMetricsTest()
Dim wb As Workbook
Dim ws As Worksheet
For Each Cell In Selection
Set wb = Workbooks.Open(Cell.Value)
For Each ws In Worksheets
Range("A1").Value = "Test"
Next ws
Next
End Sub

Answer 1

Loop Through Each Worksheet of Each Workbook
This will write a value (Test) into the same cell (A1) of each worksheet of each file (workbook) that is opened. The list of the file paths (e.g. C:\Test\Test1.xlsx) is in a column (A; more accurately A2:ALastRow) of a worksheet (Sheet1) of the workbook containing this code (ThisWorkbook).
Option Explicit
Sub UpdateMetrics()
' Source (read from)
Const sName As String = "Sheet1"
Const sCol As String = "A"
Const sfRow As Long = 2
' Destination (write to)
Const dCellAddress As String = "A1"
Const dCellValue As String = "Test"
' Reference the source (one-column) range containing the file paths.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(sws.Cells(sfRow, sCol), _
sws.Cells(sws.Rows.Count, sCol).End(xlUp)) ' ('A2:ALastRow')
Application.ScreenUpdating = False
Dim sCell As Range
Dim dwb As Workbook
Dim dws As Worksheet
Dim dFilePath As String
' Loop through the cells of the source range.
For Each sCell In srg.Cells
dFilePath = CStr(sCell.Value) ' Tolerate error values by using 'CStr'.
If Len(dFilePath) > 0 Then ' cell is not blank
If Len(Dir(dFilePath)) > 0 Then ' file exists
On Error Resume Next ' Attempt to open the file:
Set dwb = Workbooks.Open(dFilePath)
On Error GoTo 0
If Not dwb Is Nothing Then ' file was opened
' Loop through the worksheets in the current workbook...
For Each dws In dwb.Worksheets
' ... and write the value to each worksheet's cell.
dws.Range(dCellAddress).Value = dCellValue
Next dws
dwb.Close SaveChanges:=True
Set dwb = Nothing
'Else ' file was not opened; do nothing
End If
'Else ' file does not exist; do nothing
End If
'Else ' cell is blank; do nothing
End If
Next sCell
Application.ScreenUpdating = True
' Inform.
MsgBox "Metrics updated.", vbInformation
End Sub