abouelhassan قام بنشر يوليو 1, 2020 مشاركة قام بنشر يوليو 1, 2020 اخواتى فى الله بارك الله فيكم لدى مصنف به50 شيت اريد استدعاء الرقم المكتوب فى الخليةe3.f3.g3.h3.i3 لصفحة اسمها data احترامى وتقديرى استدعاء.xlsm رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يوليو 1, 2020 مشاركة قام بنشر يوليو 1, 2020 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 1 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 1, 2020 الكاتب مشاركة قام بنشر يوليو 1, 2020 تسلم ايدك ربنا ما يحرمنا منك ابداااااااااااااا يا باشا رائع جدااااااااااااااااااااااااااااااااااااا ربنا يحفظك ويسترك ويكرمك كل احترامى انا احتاج استثناء صفحات استاذى صفحة Report_Youmiوصفحة estdaa وصفحة transfer وnakdia بارك الله فيك ولك وبك رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يوليو 1, 2020 مشاركة قام بنشر يوليو 1, 2020 لا اعمل بدون ملف مرفق 1 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 1, 2020 الكاتب مشاركة قام بنشر يوليو 1, 2020 اسف استاذى تفضل اريد استثناء الصفحات الاربعة بعد data مع شكرى وتقديرى واحترامى ولو الخلية من e3.f3.g3.h3.i3 بها رقم صفر الكود لا يستدعى الصفر يتركها فارغة مع شكرى وتقديرى واحترامى استدعاء الرصيد.xlsm رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 1, 2020 الكاتب مشاركة قام بنشر يوليو 1, 2020 الحمد لله استاذى اتحلت المشكلة غيرت فى الكود هذا السطر For i = 6 To Sheets.Count واخفيت الاصفار بالتنسيق الشرطى احترامى وتقديرى لشخصك الكريم جداااا ربنا يكرمك يارب ويحفظك يارب اخيك باحترام 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يوليو 1, 2020 مشاركة قام بنشر يوليو 1, 2020 ربما كانت ارقام الصفحات التي تريد استبعادها ما بعد الرقم 6 (عن طريق نقلها الى ما بعد الرقم 6) او تم حذف صفحة او اضافة صفحة قبل الصفحة الرقم 6 (ماذا تفعل؟؟؟) لذلك يجب استبعاد هذه الصفحات اينما وجدت أترك لك مهمة حل هذه المشكلة (بعد قليل من التفكير) و عندما تعجز أخبرني 1 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 1, 2020 الكاتب مشاركة قام بنشر يوليو 1, 2020 استاذى الحبيب لقلبى سليم حاصبيا انا سارقها من كود لحضرتك هههههههههههههههه 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 انا احبك فى الله رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 3, 2020 الكاتب مشاركة قام بنشر يوليو 3, 2020 عجزت أستاذى رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 9, 2020 الكاتب مشاركة قام بنشر يوليو 9, 2020 استاذ- سليم حاصبيا مشكور بعد اذنك هل بالامكان اضافة للكود فى اخر سطر اضافة مجموع يقوم بجمع ما فوقه كما بالصورة ربنا يكرمك يااستاذى مشكور اخى واستاذى بارك الله فيك استدعاء.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر يوليو 9, 2020 أفضل إجابة مشاركة قام بنشر يوليو 9, 2020 تم معالجة الأمر 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 2 رابط هذا التعليق شارك More sharing options...
abouelhassan قام بنشر يوليو 9, 2020 الكاتب مشاركة قام بنشر يوليو 9, 2020 تعجز كلماتى عن التعبير عن مدى شكرى وسعادتى بهذا الكود الرئع استاذى واخى الكريم جداااااااااااااااااا اتمنى من الله ان يحقق لك كل ما تتمنى ويوفقك لما يحبه ويرضى اشكرك من كل قلبى استاذ سليم المبدع ملك الاكسيل احترام والتقدير من اخيك 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.