اذهب الي المحتوي
أوفيسنا

مساعدة كود تجميع خلية ثابتة فى شيتات متعددة


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

سلام عليكم
عندى ملف فيه مجموعة شيتات منهم اتنين قواعد بيانات (أسمائهم ثابتة ومعلومة) data و main مثلا ، باقى الشيتات فيهم خلية ثابتة ولتكن L2 ، محتاج كود يجمع قيم L2 من كل الشيتات ديه ما عدا شيتين قواعد البيانات، ويجيب لى المجموع فى رسالة مثلا..

 
 
 

ملف مرفق كمثال 

 

Sum multiple cells across sheets.xlsx

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

جرب هذا الملف (الصفحة Main)

الماكرو

Option Base 1
'=======================================
Private Sub CCMD_1_Click()
sum_all_L2_in_B3
End Sub
'===========================================

Sub sum_all_L2_in_B3()
    Dim first_sheet$: first_sheet = Sheets(1).Name
    Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 2).Name
    Dim t$, last_row%
   last_row = Sheets("Main").Cells(Rows.Count, 2).End(3).Row
   If last_row < 2 Then last_row = 2
    Sheets("Main").Range("b2:b" & last_row).ClearContents
    Dim First_row%: First_row = 2
 t = "=SUM('" & first_sheet & ":" & last_sheet & "'!L" & First_row & ")"

       With Sheets("Main").Cells(3, "b")
        .Offset(-1, 0) = "the sum of L2" & Chr(10) & " from sheets " & first_sheet & " to sheet " & last_sheet
        .Formula = t
        .Value = .Value
    End With
'
End Sub
'========================================
Sub sum_all_L2_with_msgbox()
    Dim first_sheet$: first_sheet = Sheets(1).Name
    Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 2).Name
    Dim t$, x$
t = "=SUM('" & first_sheet & ":" & last_sheet & "'!L" & 2 & ")"
  x = "the sum of L2" & Chr(10) & " from sheets " & first_sheet & " to sheet " & last_sheet
 MsgBox x & Chr(10) & Evaluate(t), vbMsgBoxRight
End Sub

الملف

 

Salim's_Sum.xlsm

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

مشكور جدًا أخى سليم

الحقيقة أنا كنت أبحث عن كود ديناميكى، وبحيث يكون شيت 1 هو شيت main وشيت 2 هو شيت داتا

وفى كل مرة يتم انشاء عدة شيتات غير معلومة العدد قبل البدء فى العمل

وتوصلت لأحد الأكواد الذى يعمل بشكل جيد أحببت مشاركتكم إياه

    For i = 1 To ThisWorkbook.Sheets.Count - 2
            Sum = Sum + Sheets(i).Range("L2")
        Next i

 

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

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.

×
×
  • اضف...

Important Information