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

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

قام بنشر

اخي الخازمي

اليك شرح الكود

مسح محتويات المدي

Range("c13:E41").ClearContents

عمل حلقة استمرارية علي كل شيتات الملف
For i = 1 To Sheets.Count

تجنيبب الشيت المفتوح من الحلقة الاسمرارية
If Sheets(i).Name <> ActiveSheet.Name Then

عمل متغير لنعرف منه اخرصف في العمود الثالث في شيت الورقة1
n = Sheets("æÑÞÉ1").Range("c12").End(xlDown).Row

عمل حلفة استمرارية اخري من الصف 13 والي اخر صف العامود السابق ذكره مع افتراض ان هذا العامود عدد الصفوف المستعملة به مـساو لنفس العاامود في بباقي الشيتتات

وهنا يمر الكود علي صف صف  في العامود
For r = 13 To n

ليتحقق الشرط التالي وهو لو ان الخلية في صف من صفوف الشيتات المعمول لها حلقة استمرارية تساوت مع الخلية "d5"
If Sheets(i).Cells(r, 4) = [d5] Then

عند ذلك يتم ترحيل محتويات الصف من العامود 3 الي العامود 5
With Columns(3).Rows(41).End(xlUp)
.Offset(1, 0) = Sheets(i).Cells(r, 3)
.Offset(1, 1) = Sheets(i).Cells(r, 4)
.Offset(1, 2) = Sheets(i).Cells(r, 5)
End With
End If

لاستمرار الحلقة الاستمرارية الثانية علكل صف في الشي حتي ينتهي منها
Next
End If

لاستمرار الحلقة الاستمرارية الاولي والانتقال لشيت اخر حتي ينتهي من كل الشيتات
Next

ارجو ان اكون وفقت في الشرح

تحياتي

 

  • Like 3
قام بنشر

شكرأ علي الشرح الوافي " استاذ عادل  "

لي سؤال .....

لقد اثقلت عليك سامحني

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

تجنيبب الشيت المفتوح من الحلقة الاسمرارية
If Sheets(i).Name <> ActiveSheet.Name Then

فما العمل اذا كان لدي اكثر من صفحة في الملف الاصلي .... اريد من الكود ان يستثنيها ""  مثلاً  صفحة اسمها (( المحاسب )) ويتم فيها حساب الوارد والصادر من جميع الشيتات وكذالك صفحة اخرى بإسم "  احصاء العمر "

 

قام بنشر

أخي الكريم محمدجرب تغير السطر بهذا الشكل

If Sheets(i).Name <> ActiveSheet.Name And Sheets(i).Name <> "المحاسب" Then

 

جرب الكود بهذا الشكل النهائي

Private Sub CommandButton1_Click()
    Dim I As Long, N As Long, R As Long
    Range("C13:E41").ClearContents
    For I = 1 To Sheets.Count
        If Sheets(I).Name <> ActiveSheet.Name And Sheets(I).Name <> "المحاسب" And Sheets(I).Name <> "احصاء العمر" Then
            N = Sheets(I).Range("C12").End(xlDown).Row
            For R = 13 To N
                If Sheets(I).Cells(R, 4) = [D5] Then
                    With Columns(3).Rows(41).End(xlUp)
                        .Offset(1, 0) = Sheets(I).Cells(R, 3)
                        .Offset(1, 1) = Sheets(I).Cells(R, 4)
                        .Offset(1, 2) = Sheets(I).Cells(R, 5)
                    End With
                End If
            Next
        End If
    Next
End Sub

 

  • Like 2
قام بنشر

السلام عليكم

شكراً للرجل القدير

عادل حنفي الذي اعرفه من اعماله من تاريخ 18/2/2014 وهو لايعرفني شكراً لهذا الكود الجميل بارك الله فيك

 

** طبعاً رجل الاسعاف السريع الذي لايتردد في مساعدة اي شخص في المنتدى الاستاذ ياسر خليل شكراً على الحل

 

 

  • Like 1
قام بنشر

معلمي الحبيب الغالي عادل

أنتم الأساس ولنا النبراس ، ومهمااااااااااااااااااا وصلنا فلن ننسى أبداً فضل الله ثم فضلكم علينا .. فأنتم الأعلام في هذا المجال وأنتم من أطلقتم شرارة الإبداع :yes:

تقبل وافر تقديري واحترامي

قام بنشر

اخي الحبيب ياسر

باكون سعيد جدا عندما  ارد عليك حتي و لولم تكتب شيئا لانك تذكرني انت وعدد ليس بالكثيرمن المتواجدون حاليا بايام اسماء نفتقدها جميعا اثرت المنتدي ومازالت اعمالهم ثروة لهذا المنتدي

فتحياتي اليك والشكر علي كلماتك

  • Like 1
قام بنشر

السلام عليكم شكرأ

استاذ عادل   مشكلة ان شاء الله بسيطة

اريد ان يكون احضار البيانات عن طريق شرطين وليس شرط واحد

 

If Sheets(I).Cells(r, 4) = [d5] Then

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

فقد حاولت لكن فشلت اريد  توجهكم في الطريقة الصحيحة

هذه هي المحاولة

If Sheets(I).Cells(R, 4, 5) = [D5:e5] Then

 

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