11- كود الربط ما بين شيتات الاكسل اى كان عددها بضغط زر مع تثبيت الكود كإيقونة فى كل شيتات الاكسل .

[@QuantitiesSurveying]

Sub LinkCells()
Dim wbMain As Workbook
Dim wbLinked As Workbook
Dim wsMain As Worksheet
Dim wsLinked As Worksheet
Dim mainRange As Range
Dim linkedRange As Range
Dim mainCell As Range
Dim linkedCell As Range
Dim i As Long
Dim foundWorkbook As Boolean
Set wbMain = ThisWorkbook
foundWorkbook = False


On Error Resume Next
Set mainRange = Application.InputBox("حدد النطاق الرئيسي:", Type:=8)
On Error GoTo 0

If mainRange Is Nothing Then
Exit Sub
End If

Set wsMain = mainRange.Worksheet


For Each wbLinked In Application.Workbooks
If wbLinked.Name wbMain.Name Then
foundWorkbook = True
Exit For
End If
Next wbLinked

If Not foundWorkbook Then
MsgBox "لم يتم العثور على مصنف آخر مفتوح.", vbExclamation
Exit Sub
End If


On Error Resume Next
Set linkedRange = Application.InputBox("حدد النطاق المرتبط:", Type:=8)
On Error GoTo 0

If linkedRange Is Nothing Then
Exit Sub
End If

If mainRange.Cells.Count linkedRange.Cells.Count Then
MsgBox "النطاقات المختارة ليست متساوية في الحجم.", vbExclamation
Exit Sub
End If

For i = 1 To mainRange.Cells.Count
Set mainCell = mainRange.Cells(i)
Set linkedCell = linkedRange.Cells(i)
linkedCell.Formula = "=" & mainCell.Address(External:=True)
Next i

'MsgBox "تم ربط النطاقات بنجاح."
End Sub