Adnan mushtaha قام بنشر ديسمبر 7, 2020 مشاركة قام بنشر ديسمبر 7, 2020 السلام عليكم ورحمه الله وبركاته اخواني الاعزاء تحيه طيبه وبعد احتاج ماكرو ينفذ التالي: كتابة رقم بطاقة التعريف في شيت 2 البحث عن رقم بطاقة تعريف في شيت1 ينسخ جميع الخلايا في الصف الموازي للرقم في شيت 2 test.xlsx رابط هذا التعليق شارك More sharing options...
حسين مامون قام بنشر ديسمبر 7, 2020 مشاركة قام بنشر ديسمبر 7, 2020 Sub test() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lr, x Dim rng Set ws1 = Sheets(1) Set ws2 = Sheets(2) Set rng = ws2.Range("c3") lr = ws1.Cells(Rows.Count, 2).End(3).Row For x = 2 To lr If ws1.Cells(x, 2) = rng Then ws1.Cells(x, 1).Resize(1, 4).Copy ws2.Range("b7").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False Exit For End If Next x End Sub جرب المرفق test (2).xlsm 2 رابط هذا التعليق شارك More sharing options...
Adnan mushtaha قام بنشر ديسمبر 7, 2020 الكاتب مشاركة قام بنشر ديسمبر 7, 2020 بارك الله فيك و جزاك الله خيرا عمل جبار💥 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر ديسمبر 8, 2020 مشاركة قام بنشر ديسمبر 8, 2020 بعد اذن الاخ حسين لا حاجة للحلقات التكرارية التي ترهق البرنامج (في حال البيانات الكثيرة أكثر من 500 صف) في حين يمكن وضع اليد مباشرة على الخلية المطلوبة بواسطة الدالّة Find Option Explicit Sub find_me() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim RG1 As Range Set ws1 = Sheets("ورقة1") Set ws2 = Sheets("ورقة2") ws2.Cells(7, 2).Resize(4).ClearContents Set RG1 = ws1.Range("A1").CurrentRegion.Columns(2). _ Find(ws2.Range("C3"), Lookat:=1) If Not RG1 Is Nothing Then ws1.Cells(RG1.Row, 1).Resize(, 4).Copy ws2.Cells(7, 2).PasteSpecial (12), Transpose:=True End If Application.CutCopyMode = False ws2.Cells(3, 3).Select End Sub كما يمكن عمل ذلك بمعادلة بسيطة =OFFSET(INDEX(ورقة1!$B$2:$B$9,MATCH($C$3,ورقة1!$B$2:$B$9,0)),,ROWS($A$1:A1)-2) الملف مرفق Adnan.xlsm 4 رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر ديسمبر 31, 2020 أفضل إجابة مشاركة قام بنشر ديسمبر 31, 2020 اذا كنت قد فهمت عليك ما تريده لا حاجة للكود Adnan mushtaha.xlsx 2 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان