Code to find cell in Excel files in same directory

The code below goes into a regular code module (see http://www.contextures.com/xlvba01.html#Regular for instructions).  There are still a couple of places in the code where you could have a runtime error, such as if there are workbooks in the same folder that weren't made from that template you mentioned.  This workbook itself will not be processed, so that's not a concern for it.

You can change the values of the various Const declarations to tailor it to your workbooks and worksheet layout.

Sub GatherData()

  'change these Const values to match the names of the

  'worksheets and cell addresses used in the other

  'workbooks located in the same directory with this file

  'that are to be gathered into this workbook.

  '

  'Assumed for the moment just 1 particular sheet is

  'referenced in those other workbooks.

  '

  Const otherWSName = "Sheet Name"

  Const FNameCell = "A2" ' cell that holds the first name

  Const LNameCell = "B2" ' cell that holds the last name

  Const DOBCell = "C2" ' cell that holds the date of birth

  'these are constants relating to where to put the data

  'into a sheet in THIS workbook

  Const rptSheetName = "Sheet1"

  Const fileColumn = "A" ' column to put filenames into

  Const FNameColumn = "B" ' column to put first names into

  Const LNameColumn = "C" ' column to put last names into

  Const DOBColumn = "D" ' column to put date of birth into

  Const FirstDataRow = 2 ' first row to enter data into

  'working variables used

  Dim reportWS As Worksheet ' will be the report sheet in this workbook

  Dim lastRowUsed As Long

  Dim basicPath As String

  Dim anyWBName As String ' will hold full path/name to other workbooks

  Dim otherWB As Workbook ' will reference a specific other workbook

  Dim otherWS As Worksheet ' will reference worksheet in other workbook

  Set reportWS = ThisWorkbook.Worksheets(rptSheetName)

  lastRowUsed = reportWS.Range(fileColumn & Rows.Count).End(xlUp).Row

  If lastRowUsed < FirstDataRow Then

    lastRowUsed = FirstDataRow

  End If

  'delete all previous information (could use .ClearContents instead of .Delete)

  reportWS.Rows(FirstDataRow & ":" & lastRowUsed).EntireRow.Delete

  'now we're ready to start, get the path to this workbook

  basicPath = ThisWorkbook.Path & Application.PathSeparator

  'get any Excel workbook filename to "seed" anyWBName

  anyWBName = Dir$(basicPath & "*.xls*") ' any Excel file as .xls, .xlsx, .xlsm

  Application.ScreenUpdating = False ' speeds up processing, prevents flickering

  Do While anyWBName <> ""

    'don't process this workbook!

    If anyWBName <> ThisWorkbook.Name Then

      'it is some other Excel workbook in same folder

      Application.EnableEvents = False ' keep any auto-macros from running

      Application.DisplayAlerts = False ' keep quiet about updating anything.

      On Error Resume Next

      Set otherWB = Workbooks.Open(basicPath & anyWBName)

      Set otherWS = otherWB.Worksheets(otherWSName)

      'now transfer the data

      'get the next empty row in this workbook

      lastRowUsed = reportWS.Range(fileColumn & Rows.Count).End(xlUp).Row + 1

      If lastRowUsed < FirstDataRow Then

        lastRowUsed = FirstDataRow

      End If

      reportWS.Range(fileColumn & lastRowUsed) = otherWB.FullName ' path and filename

      If IsEmpty(otherWS.Range(FNameCell)) Then

        reportWS.Range(FNameColumn & lastRowUsed) = "Missing"

      Else

        reportWS.Range(FNameColumn & lastRowUsed) = otherWS.Range(FNameCell)

      End If

      If IsEmpty(otherWS.Range(LNameCell)) Then

        reportWS.Range(LNameColumn & lastRowUsed) = "Missing"

      Else

        reportWS.Range(LNameColumn & lastRowUsed) = otherWS.Range(LNameCell)

      End If

      'set date format in this workbook

      With reportWS.Range(DOBColumn & lastRowUsed)

        .NumberFormat = "dd-mmm-yyyy"

        If IsEmpty(otherWS.Range(DOBCell)) Then

          .Value = "Missing"

        Else

          .Value = otherWS.Range(DOBCell)

        End If

      End With

      'close the other workbook, don't save any changes

      otherWB.Close False

      Application.EnableEvents = True ' allow normal 'event' processing

      Application.DisplayAlerts = True ' allow system alerts to appear again.

      If Err <> 0 Then

        Err.Clear

      End If

      On Error GoTo 0 ' reset error trapping

      'get another filename

      anyWBName = Dir$() ' uses original parameters

    End If

  Loop ' end of test for anyWBName <> ""

  'release used resources back to the operating system

  Set otherWB = Nothing

  Set otherWS = Nothing

  Set reportWS = Nothing

  MsgBox "All other Excel workbooks in this folder have been processed.", _

   vbOKOnly + vbInformation, "Task Completed"

End Sub

[EDIT] code changed on 6/19/2012 - to set .DisplayAlerts = True properly just above the

If Err <> 0 Then

statement - JLL.