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