ارجو المساعده في عمل هايبر لينك متعدد

[احمد محمد ماترك]

السلام عليكم ورحمه الله وبركاته 

اساتذتي الكرام ارجو المساعده 

عندي ملف به عدد كبير من الشيتات واريد ان اعمل هايبر لينك لكل صفحه طبعا عندي في حدود 600 شيت يعني الموضوع متعب لو عملت صفحه صفحه فانا اريد اعمل هايبر لينك للجميع بضغط واحده  

الملف مرفق يوضح المطلوب

New Microsoft Excel Worksheet.rar

[سليم حاصبيا]

جرب هذا الكود

Option Explicit

Sub Create_Hyper()
Dim wsSheet As Worksheet
Dim lnRow As Long


   Application.ScreenUpdating = False
  
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Sheets("Sheet1").Range("H5:H" & Rows.Count).ClearContents
 lnRow = 5
For Each wsSheet In Sheets
    If wsSheet.Name <> "Sheet1" Then
        With Sheets("Sheet1")
           .Hyperlinks.Add .Cells(lnRow, "H"), "", _
            SubAddress:="'" & wsSheet.Name & "'!A1", _
            TextToDisplay:="Goto:" & wsSheet.Name
        End With
        lnRow = lnRow + 1
     
    End If
Next wsSheet
  Salim_button
Application.ScreenUpdating = True
End Sub
'=============================
Sub select_sheet()
 Sheets("Sheet1").Select
End Sub
'=============================
Sub Salim_button()
Dim x%: x = Sheets.Count
Dim i%
For i = 1 To x
If Sheets(i).Name <> "Sheet1" Then
    Sheets(i).Buttons.Delete
        With Sheets(i).Buttons.Add(218.5, 1.5, 170, 31)
            .OnAction = "select_sheet"
            .Font.Name = "Calibri"
            .Font.FontStyle = "Bold Italic"
            .Font.ColorIndex = 3
            .Characters.Text = " SALIM SAY: Go_To_SHEET1"
        End With
 End If
    Next
End Sub

الملف مرفق

 

Hyper_to_sheets.xlsm

[احمد محمد ماترك]

هوه ده المطلوب فعلا وانا مهما اشكرك مش هوافيك وربنا يارب يجعل هذا العمل في ميزان حسناتك وجزاك الله كل خير ...الف الف شكر لحضرتك

[وجيه شرف الدين]

بعد اذنا استاذنا الكبير الاستاذ سليم واثراء للموضوع اقدم هذا الشيت

New Microsoft Excel Worksheet.xlsm