استدعا ء من 5 خلايا بكل المصنف

[abouelhassan]

اخواتى فى الله

بارك الله فيكم

لدى مصنف به50 شيت اريد استدعاء الرقم المكتوب فى الخليةe3.f3.g3.h3.i3

لصفحة اسمها data 

احترامى وتقديرى

استدعاء.xlsm

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

Try this macro

Option Explicit
Sub Fill_data()
Dim i%, t%
Dim Rg As Range
t = 2
With Sheets("data")
  Set Rg = .Range("A1").CurrentRegion
  If Rg.Rows.Count > 1 Then _
   Rg.Offset(1).Resize(Rg.Rows.Count - 1).ClearContents
   
   For i = 2 To Sheets.Count
         If Sheets(i).Name <> "data" Then
           .Cells(t, 1) = Sheets(i).Name
           .Cells(t, 2).Resize(, 5).Value = _
           Sheets(i).Cells(4, 5).Resize(, 5).Value
           t = t + 1
         End If
   Next i
End With
End Sub

 

[abouelhassan]

تسلم ايدك ربنا ما يحرمنا منك ابداااااااااااااا يا باشا

رائع جدااااااااااااااااااااااااااااااااااااا

ربنا يحفظك ويسترك ويكرمك

كل احترامى

انا احتاج استثناء صفحات استاذى صفحة Report_Youmiوصفحة estdaa وصفحة transfer وnakdia

بارك الله فيك ولك وبك

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

لا اعمل بدون ملف مرفق

[abouelhassan]

اسف استاذى تفضل

اريد استثناء الصفحات الاربعة بعد data

مع شكرى وتقديرى واحترامى

ولو الخلية من e3.f3.g3.h3.i3 بها رقم صفر

الكود لا يستدعى الصفر يتركها فارغة

مع شكرى وتقديرى واحترامى

استدعاء الرصيد.xlsm

[abouelhassan]

الحمد لله استاذى اتحلت المشكلة غيرت فى الكود هذا السطر

   For i = 6 To Sheets.Count

واخفيت الاصفار بالتنسيق الشرطى

احترامى وتقديرى لشخصك الكريم جداااا

ربنا يكرمك يارب ويحفظك يارب 

اخيك باحترام

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

ربما كانت ارقام الصفحات التي تريد استبعادها ما بعد الرقم 6  (عن طريق نقلها الى ما بعد الرقم 6)

او تم حذف صفحة او  اضافة صفحة   قبل  الصفحة الرقم 6   (ماذا تفعل؟؟؟)

لذلك يجب استبعاد هذه الصفحات اينما وجدت 

أترك لك مهمة حل هذه المشكلة  (بعد قليل من التفكير) و عندما تعجز أخبرني

[abouelhassan]

استاذى الحبيب لقلبى سليم حاصبيا

انا سارقها من كود لحضرتك هههههههههههههههه

  Dim Arr(1 To 3)
  Arr(1) = "estdaa": Arr(2) = "nakdia": Arr(3) = "Report_Youmi":
Match = IsError(Application.Match(Sh.Name, Arr, 0))
If Not Match Then GoTo Next_Sheet

انا احبك فى الله

[abouelhassan]

عجزت أستاذى

 

 

[abouelhassan]

 استاذ- سليم حاصبيا

مشكور بعد اذنك هل بالامكان اضافة للكود فى اخر سطر اضافة مجموع يقوم بجمع ما فوقه كما بالصورة ربنا يكرمك يااستاذى

مشكور اخى واستاذى بارك الله فيك

استدعاء.xlsm

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

تم معالجة الأمر

Option Explicit
Sub Fill_data()
Dim i%, t%
Dim Rg As Range
t = 2
With Sheets("data")
  Set Rg = .Range("A1").CurrentRegion
  If Rg.Rows.Count > 1 Then _
   Rg.Offset(1).Resize(Rg.Rows.Count - 1).Clear
   For i = 2 To Sheets.Count
         If Sheets(i).Name <> "data" Then
           .Cells(t, 1) = Sheets(i).Name
           .Cells(t, 2).Resize(, 5).Value = _
           Sheets(i).Cells(4, 5).Resize(, 5).Value
           t = t + 1
         End If
   Next i
  With .Cells(t, 1)
    .Value = "Sum"
    .Offset(, 1).Resize(, 5).Formula = _
     "=SUM(B2:B" & t - 1 & ")"
    .Resize(, 6) _
     .Interior.ColorIndex = 6
    
  End With

   
   Set Rg = .Range("A1").CurrentRegion
   If Rg.Rows.Count > 1 Then
   Set Rg = Rg.Offset(1).Resize(Rg.Rows.Count - 1)
      With Rg
        .Borders.LineStyle = 1
        .InsertIndent 1
        .NumberFormat = "#,##.00"
          With .Font
          .Bold = 1: .Size = 14:
          End With
         .Value = .Value
      End With
   End If
End With


End Sub

الملف مرفق

 

Abo_Hasn.xlsm

[abouelhassan]

تعجز كلماتى عن التعبير عن مدى شكرى وسعادتى بهذا الكود الرئع

استاذى واخى الكريم جداااااااااااااااااا

اتمنى من الله ان يحقق لك كل ما تتمنى ويوفقك لما يحبه ويرضى

اشكرك من كل قلبى

استاذ سليم المبدع ملك الاكسيل

احترام والتقدير من اخيك