اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


marwa41
إذهب إلى أفضل إجابة Solved by محمد هشام.,

الردود الموصى بها

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

  • Like 3
رابط هذا التعليق
شارك

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

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

رابط هذا التعليق
شارك

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

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

  • Like 2
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information