Sub coord()
Dim wb As Workbook
Dim sht As Worksheet
Dim sht2 As Worksheet
Dim rnge As Range
'assuming that the source workbook is currently open
Set wb = Workbooks("book1")
For Each sht In wb.Sheets
On Error Resume Next
Set sht2 = ActiveWorkbook.Sheets(sht.Name)
On Error GoTo 0
If Not sht2 Is Nothing Then
For Each rnge In sht.UsedRange
If sht2.Range(rnge.Address).Value = "" And rnge.Value <> "" Then
sht2.Range(rnge.Address).Formula = "='[" & wb.Name & "]" & sht.Name & "'!" & rnge.Address
End If
Next rnge
Set sht2 = Nothing
End If
Next sht
Set wb = Nothing
End Sub