نسخ الخانات فى toutal تلقائى برمجية

[marwa41]

السلام عليكم   اريد ملئ الخانات فى toutal تلقائى برمجية ..اريد عند ضغط على هيبر لينك تبدا بخانة a3 تلقائى

mango2023.xlsm

[محمد هشام.]

Sub MH_hyperkunks()
Dim Ws As Worksheet
Worksheets("toutal").Range("A3:a100").ClearContents
Range("A3").Select
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "toutal" Then
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:="" & Ws.Name & "!A1" & "", ScreenTip:="", TextToDisplay:=Ws.Name
ActiveCell.Offset(1, 0).Select
End If
Next Ws

End Sub

mango2023(1).xlsm

[marwa41]

اريد  نسخ القيم بالخلايا  من كل  صفحة  الى الخلايا فى الصفحة TOUTAL عند التغير فى الصفحة 

mango2021-2022-2023.xlsm

[محمد هشام.]

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

المرجوا المزيد من التوضيح او إرفاق ملف به نموذج  للنتيجة المتوقعة. لأنني بصراحة لم أستوعب طلبك جيدا 

[marwa41]

سلام من الله عليكم من ارض مصر الى اهل المغرب

المطلوب فى صفحة toutal

mango2021-2022-2023 (1).xlsm

[محمد هشام.]

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

هل نسخ القيم يقتصر على الأوراق الموجودة أم هناك احتمال الزيادة (hakan11  او  12) 

[marwa41]

زيادة كثيرة جدا  ولا اعرف العدد  ممكن ا لى  250 او 350 صفحة

 

[محمد هشام.]

جرب اخي هل هو المطلوب فعلا لاني حتى الانتهاء من وضع المعادلات اكتشفت وجود كود لاضافة اوراق جديدة تلقائيا وبهده الطريقة المعادلات الموضوعة لا يمكنها التعرف على الشيت المضاف الا بعد التعديل

mango2021-2022-2023 (1).xlsm

[محمد هشام.]

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

اولا اسف على التاخير لم استطيع امس تعديل المعادلات بسبب ضيق الوقت وعدم توضيحك المسبق لامكانية زيادة اوراق العمل

تفضل اخي تم وضع المعادلات لغاية 350 صف قابل للزيادة مع التعرف تلقائيا على اوراق العمل المضافة

اما في حالة كانت عندك رغبة بالبحث فقط بالقيمة الموجودة في الخانة B4

يمكنك استبدال الكود الموجود في حدث ورقة toutal بهدا الكود رغم اني ارى ان المعادلات افضل بسبب انها تتيح لك رؤية جميع النتائج الموجودة في اوراق العمل كلها في نفس الوقت

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
If Target.Address = "$B$4" Then
        Me.Cells(4, 3).Resize(, 12).ClearContents
        If Not IsEmpty(Target) Then
            Set ws = Worksheets(Target.Value)
            Select Case ws.Name
                Case "toutal":
                Case Else:
                    With Me
                        .Range("C4") = ws.Range("B11")
                        .Range("D4") = ws.Range("B6")
                        .Range("E4") = ws.Range("B8")
                        .Range("F4") = ws.Range("M6")
                        .Range("G4") = ws.Range("B12")
                        .Range("H4") = ws.Range("B13")
                        .Range("I4") = ws.Range("B17")
                        .Range("J4") = ws.Range("K47")
                        .Range("K4") = ws.Range("L47")
                        .Range("L4") = ws.Range("M47")
                        .Range("M4") = ws.Range("N47")
                        .Range("N4") = ws.Range("C81")
                    End With
            End Select
        End If
    End If
    
    End If

If Target.Count > 1 Or Target.Row <= 2 Then Exit Sub
If Target.Column = 2 And Target.Value <> "" And Not (sheetExists(Target.Value)) Then
Call newsh(Target.Value)
Sheets("toutal").Select

End If
End Sub

mango_MH.xlsm