عادل حنفي

اخي الخازمي

لا تتقيل ولا شئ قول ما بخاطرك

كما يشرفني معرفتك اخي

وسعدت برد اخي ياسر فقد كفي ووفي

تحياتي

اخي الخازمي

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

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

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

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

تحياتي

اخي العزيز عبد العزيز البسكري

اخي العزيز م / ياسر فتحى البنا

اشكركما علي كلماتكما عزكما الله

خالص تحياتي وتقديري

اخي الفاضل

    هذان السطرا تم ايقافهما بالعلامة الموضوعة علي يسار كل سطر

'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
هذان السطران تعريف لمتغيرات يختارها المبرمج ويقوم بتعريف البرنامج عليه وعلي ماذا تشير

Dim sht As Worksheet
Dim LastRow As Long
هذا السطر جعل المبرمج احد المتغيرات عندما يذكرها فانها تشير الي الشيت رقم 1 في هذا الملف

Set sht = ThisWorkbook.Worksheets("Sheet1")
هذا السطر تم ايقافه
'Ctrl + Shift + End
هنا يعرف المبرمج المتغير الثاني وهو يشير الي الصف الاخير للخلاياالغير فارغة في العمود الاول من الشيت الاول
  LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

هذا السطر تم ايقافه(ويعتبر كعنوان لايؤثر في
الكود) 
'Using UsedRange
هنا يتم معرفة مدي الخلايا المستخدمة
  sht.UsedRange 'Refresh UsedRange
هنا جعل المتغير الثاني يساوي اخر صف في صفوف المدي المستخدم
  LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row

هذا السطر تم ايقافه(ويعتبر كعنوان لايؤثر في
الكود
'Using Table Range

هنا جعل المتغير الثاني يساوي عدد صفوف الجدول المستخدم
  LastRow = sht.ListObjects("Table1").Range.Rows.Count

هذا السطر تم ايقافه(ويعتبر كعنوان لايؤثر في
الكود
'Using Named Range

هنا جعل المتغير الثاني يساوي عدد صفوف مدي مخفوظ 
  LastRow = sht.Range("MyNamedRange").Rows.Count

هذا السطر تم ايقافه
'Ctrl + Shift + Down (Range should be first cell in data set)

هنا جعل المتغير الثاني يساوي عدد صفوف الخلايا المستخدمة 
  LastRow = sht.Range("A1").CurrentRegion.Rows.Count

End Sub

ارجو ان تكون هناك افادة

تحياتي

اخي محمد الخازمي

ارجو ان يكون المرفق هو المطلوب

تحياتي

جلب بيانات من اكثر من شيت.rar

اخي الفاضل

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

تحياتي

اخي

تم عمل تعديل بسيط لتسهيل الموضوع ارجو انه لايؤثر علي العمل

جرب المرفق واخبرتي النتيجة

تحياتي

YouQu.rar

اخي الفاضل

هذه رسالة خطأ في سطرين من الاكواد تم ايقافهما لم يهمني البحث في معناهما بقدر رفع الملف لك مرة اخري حفاظا عليه ولتطمأن عليه

تحياتي

PO2.rar

عذرا اخي اسامه لم اري ردك الا بعد ان رفعت مشاركتي

اوافقك الراي لسببين اولا لان المعادلات مع كثرتها بالملف تجعل الملف ثقيل

ثانيا لمحاولة مساعدتك لتقوم بهذا العمل بعد كده لوحدك

لذا اوعدك بالشرح في اقرب وقت ان شاء الله

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

اخي ابو سليمان

اولا اشكرك علي كلماتك الطيبة

وبعدين انت لاتريد اظهار علامة (=) فما بالك بالمعادلات

تحاتي

وبارك الله فيك اخي عبد العزيز شاكرا لمرورك

تحياتي

اخي الحبيب حسام عيسي

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

والي الامام دائما

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

وهذا ملف يحافظ علي لون الخلية والبوردر

افسينا1 .rar

اخي ابو سليمان

جرب المرفق وان شاء الله يكون المطلوب

تحياتي

افسينا .rar

السلام عليكم

اخواني الموضوع جميل ويحتمل افكار كتير

وكذلك يمكن الدمج بين اكثر من فكرة وانا اخترت هذا الاخير

فقمت بادماج عمل اخي سلطان مختار

مع ادخال التكست بوكس في هذا العمل والتغيير في خاصية PasswordChar

وهذا يحل موضوع حفظ الباسورد في مكان اخر

ارجو التجربة اخباري النتيجة

تحياتي

Passwords1.rar

اخيرالفاضل

نزلت الملف الاخير وهو يعمل عندي بصورة طبيعية اشرح ما يحدث عند بالضبط لمحاولة اصلاح المشكلة

تحياتي

تفضل اخي

تحياتي

ملف قبل كود الطباعة.rar

السلام عليكم

وبعد الاذن من اخواني الاساتذة

اخي جرب الاتي

اكتب السطر التالي قبل سطر الخطأ  لتعريف المتغير

Dim mm

اخي ابو عبد الرحمن

اولا عند عمل زر الطباعة لم يمس اي كود لاي زر اخر بالمرة

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

تحياتي

اخي قنديل الصياد

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

تحياتي

السلام عليكم

اخي ولد الحجاز

بعد اذن الاخوة

هل تقصد كما في المرفق

xx.rar

اخي عبد العزيز البسكري

الله عليك

تحياتي

اخي ياسر

بارك الله في مجهودك

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

اخي الفاضل

لانملك الا الدعاء لاخينا الحسامي بالرحمة والمغفرة انه قريب سميع

اخي نرجوا توضيح طلبك ما المطلوب بالضبط حتي لا يكون المجهود بدون نتيجة

تحياتي

الحمد لله

اتغيير المدي في الكود الخاص بزر الطباعة وكوده هو

Private Sub CommandButton1_Click() '
r = Sheets("الاكواد").Range("A3").Address
s = Sheets("الاكواد").Range("A2").End(xlDown).Address
For i = 4 To 14
If Cells(i, 7) <> "" Then
o = Cells(i, 7).Address
 g = Application.WorksheetFunction.CountIf(Sheets("الاكواد").Range(r, s), Range(o))
 If g = 1 Then
 Range("A2") = Cells(i, 7)
' If Range("f5") <> "" Then
m = Range("A1").Address
n = Range("F4").End(xlDown).Address
  ActiveSheet.PageSetup.PrintArea = m & ":" & n
  ActiveSheet.PrintOut Copies:=1
 ' End If
End If
End If
Next
End Sub

قم بتغيير ال14 في السطر التالي بالزيادة او النقصان

For i = 4 To 14

تحياتي