أبو حنــــين

السلام عليكم انسخ هذا الكود في الصفحة رقم 1 Private Sub Worksheet_Change(ByVal Target As Range) Last_Row = ورقة2.Cells(Rows.Count, "D").End(xlUp).Row + 1 LastRow = ورقة3.Cells(Rows.Count, "D").End(xlUp).Row + 1 If Not IsEmpty(Target) Then If Target.Column = 3 Then ورقة2.Cells(Last_Row, 4) = Target.Value Else If Target.Column = 4 Then ورقة3.Cells(LastRow, 4) = Target.Value End If End If End If End Sub

السلام عليكم جرب اخي المرفق اعمال السنة نصفالعام السادس 2014.rar

السلام عليكم جرب هذا الكود في موديل Sub sFind() Dim i As Long Dim C With Sheets("Sheet1") .Range("D4:D850") = "" MsgBox "هذه العملية تتطلب بعض الوقت", vbInformation, "ملاحظة" Application.ScreenUpdating = False For Each C In .Range("C4:C850") For i = 4 To 850 If C = .Cells(i, 2) Then C.Offset(0, 1) = .Cells(i, 2) Next Next Application.ScreenUpdating = True MsgBox "تم الحضول على " & Application.WorksheetFunction.CountIf(.Range("D4:D850"), "<>") & " اسم", vbInformation, "النتيجة" End With End Sub

السلام عليكم اخي يوسف جرب المرفق ************************************* تم تعديل المرفق حسابات 2013-12-4 _3.rar

السلام عليكم اخي احمد ريان هل يكون الفورم بهذا الشكل فور م.rar

السلام عليكم الأخ حسين مبروك الترقية و مزيد من الابداعات

السلام عليكم اخي ابراهيم هذا الكود يقوم بجلب البيانات عند كتابة رقم الكتاب مع الملاحظة انه يجلب بيانات سطرين متتالين فقط Private Sub sear_AfterUpdate() With ورقة1 Last = .Cells(Rows.Count, "A").End(xlUp).Row For i = 4 To Last: For ii = 1 To 5 If CStr(sear) = CStr(.Cells(i, 1)) Then Me.Controls("TextBox" & ii).Value = .Cells(i - 1, ii) Me.Controls("TextBox" & ii + 5).Value = .Cells(i, ii) End If: Next: Next: End With End Sub

اخي kingdz2011 اخي AHMED2512 جزاكما الله خيرا

السلام عليكم جزاك الله خيرا أخي الزباري على هذا العمل تقبل تحياتي

السلام عليكم اخي المطلوب غير واضح و لا يوجد اي سؤال في الملف

السلام عليكم اخي احمد ريان تفضل المرفق 2003 البحث في عدة اعمدة 2003.rar

السلام عليكم جرب المرفق 2.rar

السلام عليكم انظر المرفق رفع.rar

السلام عليكم اخي الكلمة sheet ينقصها الحرف s فقط لتصبح sheets(x).select بدلا من sheet(x).select

السلام عليكم بالفعل عوض اضافة العدد 5 اضفت العدد 1 و هذا هو التصحيح Private Sub CommandButton1_Click() With ورقة1 Last = .Cells(Rows.Count, "A").End(xlUp).Row + 1 For i = 1 To 5 .Cells(Last, i) = Me.Controls("TextBox" & i).Value .Cells(Last + 1, i) = Me.Controls("TextBox" & i + 5).Value Next Unload Me .PrintPreview End With End Sub

جرب المرفق Book1.rar

السلام عليكم اخي ابراهيم يصبح الكود كالتالي Private Sub CommandButton1_Click() With ورقة1 Last = .Cells(Rows.Count, "A").End(xlUp).Row + 1 For i = 1 To 5 .Cells(Last, i) = Me.Controls("TextBox" & i).Value .Cells(Last + 1, i) = Me.Controls("TextBox" & i + 1).Value Next Unload Me .PrintPreview End With End Sub

السلام عليكم اعتقد انه عند نقلك للملف ربما لم تنقل ليسبوكس رقم 2 في الملف المرسل سابقا هناك ليستبوكس1 و ليستبوكس2 جعلت عرضها تقريبا منعدم لاننا لا نحتاج الى رؤيتها انظر الصورة بدون عنوان.rar

اخي مصطفى اذا كنت قد نقلت الكود الى ملف آخر بيجب ان : يكون الملف الآخر بنفس تنسيق الملف المرسل ان تنقل الاكواد الموجودة صفحة الفواتير و في موديل به كود اسمه sFind و موديل به كود اسمه iSave_ToSheets و كود مكتوب في الحدث Workbook_Open او انني لم افهم ماذا تقصد سؤالك الاخير

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

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

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

أخي الأستاذ أحمد فصيله اخي الأستاذ حكيم اخي الأستاذ جلال محمد جزاكم الله خيرا كنت على عجل في الملف السابق بسبب موعد المدرسة و ها هو الملف بعد التعديل كود لنقل البيانات - الحسامي22.rar

على السريع جرب المرفق كود لنقل البيانات - الحسامي.rar

جرب المرفق مثال_1.rar