Sub JohnGCopyData()
'Variables Declaration
Dim rngAddressTable As Range
Dim lTableLastRow As Long
Dim lRowNum As Long
Dim sPath As String
Dim sSourceSheetName As String
Dim sSourceCellAddress As String
Dim sDestSheetName As String
Dim sDestCellAddress As String
Dim wkbSourceBook As Workbook
Dim vCopyValue As Variant
Application.Cursor = xlWait
Application.ScreenUpdating = False
'Create a reference to the reference table
With ThisWorkbook.Worksheets("RefTableSheetName")
'determine the last used row on the sheet
lTableLastRow = .Range("A65536").End(xlUp).Row
'We need to include cells A2 [ represeneted by .Cells(2, 1)]
' to Elastrowused[ represeneted by .Cells(lTableLastRow, 5)]
Set rngAddressTable = .Range(.Cells(2, 1), .Cells(lTableLastRow, 5))
End With
'Loop through each row in the table
For lRowNum = 1 To rngAddressTable.Rows.Count
'Get the values from the table
With rngAddressTable
sPath = .Cells(lRowNum, 1) 'first column on curent row
sSourceSheetName = .Cells(lRowNum, 2) 'second column on current row
sSourceCellAddress = .Cells(lRowNum, 3) 'etc...
sDestSheetName = .Cells(lRowNum, 4)
sDestCellAddress = .Cells(lRowNum, 5)
End With
'Only continue if the Source file can be found
If Len(Dir(sPath)) > 0 Then
'Open the Source workbook
Set wkbSourceBook = Application.Workbooks.Open(sPath)
'Only continue if the Source Worksheet exists
If SheetExists(wkbSourceBook.Name, sSourceSheetName) Then
'Get the value
vCopyValue = wkbSourceBook.Worksheets(sSourceSheetName).Range(sSourceCellAddress).Value
'Now we can close the Source Workbook
'without saving any changes
wkbSourceBook.Close False
'Only continue if the Destination Worksheet exists
If SheetExists(ThisWorkbook.Name, sDestSheetName) Then
'Add the value to the correct cell in this workbook
ThisWorkbook.Worksheets(sDestSheetName).Range(sDestCellAddress).Value = vCopyValue
End If
End If
End If
Next lRowNum
Application.ScreenUpdating = False
Application.Cursor = xlWait
'Clear Object Variables
Set wkbSourceBook = Nothing
End Sub
Function SheetExists(ByVal BookName As String, ByVal SheetName As String) As Boolean
Dim wkbBook As Workbook
Dim wksSheet As Worksheet
Dim bTemp As Boolean
'Loop through all open workbooks
For Each wkbBook In Application.Workbooks
'Find a matching book name
If wkbBook.Name = BookName Then
'Loop through all sheets
For Each wksSheet In wkbBook.Worksheets
'If we find a match record a true value
' and exit the loop
If wksSheet.Name = SheetName Then
bTemp = True
Exit For
End If
Next wksSheet
End If
'No need to contine if we found a match
If bTemp Then Exit For
Next wkbBook
'Set the function return value
SheetExists = bTemp
End Function
