Copying value from 1 cell from various spreadsheet

Hi,

I have several workbooks that I want to extract the value from cell D1 in each worksheet from and place into a master spreadsheet. The end result is shown on the NOTOK control excel file. The rest of the files of NOTOK represent the data worksheets to be extracted from. Thanks in advance to anyone who can help.

Try this:

Option Explicit

Sub CollectData()
Dim fPath As String, fName As String
Dim NR As Long, ws As Worksheet, wb As Workbook

With ThisWorkbook.Sheets("Sheet1")
    .Range("B:D").UsedRange.Offset(1).ClearContents     'clear prior report
    NR = 2                                              'next row to add data
    fPath = .Range("A2")
    If Right(fPath, 1) <> Application.PathSeparator Then _
          fPath = fPath & Application.PathSeparator

    fName = Dir(fPath & "*.xls")            'get first filename
    Application.ScreenUpdating = False      'speed up macro execution
    
    Do While Len(fName) > 0                 'abort when all files completed
        Set wb = Workbooks.Open(fPath & fName)  'open the found file
        .Range("B" & NR) = fName            'add filename to report
        For Each ws In wb.Worksheets        'get data from each sheet in wb
            .Range("C" & .Rows.Count).End(xlUp).Offset(1) = ws.Name
            .Range("C" & .Rows.Count).End(xlUp).Offset(, 1).Value = ws.Range("D1").Value
        Next ws
        wb.Close False                      'close the wb, no changes
        NR = .Range("C" & .Rows.Count).End(xlUp).Row + 1    'next row for next wb
        fName = Dir                         'get next filename
    Loop

    Application.ScreenUpdating = True
End With

End Sub

Like so:

        For Each ws In wb.Worksheets        'get data from each sheet in wb
          If ws.Visible = xlSheetVisible Then
            .Range("C" & .Rows.Count).End(xlUp).Offset(1) = ws.Name
            .Range("C" & .Rows.Count).End(xlUp).Offset(, 1).Value = ws.Range("D1").Value
          End If
        Next ws