VBA Code 2 import many cells not in range from many workbooks

Option Explicit
' user definded data type to hold sheet and cell information
Type lookupInformation
   sheet As String ' sheet name
   cell As String  ' cell example D4
   header As String 'header to be posted on new workbook
End Type

'main sub routine
'
Public Sub copySpecificCellsFromWorkbooks()

   Dim workbookLocation          As String ' where workbooks are
   Dim setupSheet                As String ' set up sheet. contains information about sheet name
                                           ' and cell on that sheet that needs to be copied.
   Dim processWorkbookName       As String 'workbook to process
   Dim lookupInformations()      As lookupInformation ' sheet name and cell information from where data needs to be copied
   Dim newWorkbook               As Workbook     ' new workbook
   Dim finalRow                  As Long   ' number of rows used on the final sheet
   
   setupSheet = "Setup"
   workbookLocation = "C:\Users\haadi\Documents\test"
   
   lookupInformations = obtainSetup(setupSheet)
   
   processWorkbookName = Dir(workbookLocation & "\*.xls*")
   If (processWorkbookName <> vbNullString) Then
      Set newWorkbook = Workbooks.Add
      Call writeheader(newWorkbook, lookupInformations)
      finalRow = 1
      
      Do While (processWorkbookName <> vbNullString)
         finalRow = finalRow + 1
         Call processWorkbook(workbookLocation & "\" & processWorkbookName, lookupInformations, newWorkbook, finalRow)
         processWorkbookName = Dir()
      Loop
   End If
End Sub

Private Sub writeheader(newWorkbook As Workbook, lookupInformations() As lookupInformation)
Dim counter       As Long

   With newWorkbook.Sheets("Sheet1")
      For counter = LBound(lookupInformations) To UBound(lookupInformations)
         .Cells(1, counter) = lookupInformations(counter).header
      Next counter
   End With
End Sub

Private Function obtainSetup(setupSheet As String) As lookupInformation()
   Dim lookupInformations()      As lookupInformation
   Dim setupRow                  As Integer

   With Sheets(setupSheet)
      setupRow = .Cells(.Rows.Count, "B").End(xlUp).Row
      ReDim lookupInformations(0 To setupRow - 1)
      Do While (setupRow > 1)
         lookupInformations(setupRow - 2).header = .Cells(setupRow, "A")
         lookupInformations(setupRow - 2).sheet = .Cells(setupRow, "B")
         lookupInformations(setupRow - 2).cell = .Cells(setupRow, "C")
         setupRow = setupRow - 1
      Loop
   End With
   obtainSetup = lookupInformations
   
End Function

Private Sub processWorkbook(workbookFullName As String, lookupInformations() As lookupInformation, newWorkbook As Workbook, finalRow As Long)
Dim readWorkbook           As Workbook
Dim counter                As Integer
Dim sheet                  As String
Dim cell                   As String

   Set readWorkbook = Workbooks.Open(workbookFullName)
   With newWorkbook.Sheets("Sheet1")
      For counter = LBound(lookupInformations) To UBound(lookupInformations)
         sheet = lookupInformations(counter).sheet
         cell = lookupInformations(counter).cell
         .Cells(finalRow, counter + 1) = readWorkbook.Sheets(sheet).Range(cell)
      Next counter
      readWorkbook.Close SaveChanges:=False
      Set readWorkbook = Nothing
   End With
   
End Sub


.