أبو وليد قام بنشر ديسمبر 1, 2015 مشاركة قام بنشر ديسمبر 1, 2015 السلام عليكم مساء الخير لدي ملف في مجموعة أوراق الأولى الرئيسية اريد ان تنسخ السجل الذي يوازي خليه الورقة نفس اسم الورقة الأخرى لعل المرفق يوضح ذلك Book1.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 1, 2015 مشاركة قام بنشر ديسمبر 1, 2015 أخي الكريم أبو وليد السلام عليكم جرب الكود التالي .. يضع السجل (الخلية التي توازي خلية الورقة) في الخلية A1 في الورقة المطابقة لاسم ورقة العمل أرجو أن يكون المطلوب .. Sub Transfer() Dim Cel As Range For Each Cel In Sheets("main").Range("A2:A" & Sheets("main").Cells(Rows.Count, 1).End(xlUp).Row) If Evaluate("=ISREF('" & Cel.Value & "'!A1)") Then Sheets("" & Cel.Value & "").Range("A1") = Cel.Offset(0, 1).Value End If Next Cel End Sub رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 1, 2015 الكاتب مشاركة قام بنشر ديسمبر 1, 2015 بارك الله فيك وضعته في الصفحه الرئيسيه ولم يحدث شيء ممتاز وجدته ماكرو جميل جدا عزيزي اريد عند تحديث القيمه في الرئيسة يضاف في خليه جديده وليس مكان السابق واذا كانت القيمة موجودة سابقا لا يضيفها رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 1, 2015 مشاركة قام بنشر ديسمبر 1, 2015 أخي الكريم لا أستطيع فهم المطلوب بشكل كافي يرجى التوضيح مع ذكر مثال بما تطلب ..أو ارفق بعض النتائج المتوقعة لتتضح الصورة رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 1, 2015 الكاتب مشاركة قام بنشر ديسمبر 1, 2015 اقصد في المرة الأولى توضع في الخلية الأولى عند التنفيذ مره أخرى تنقل للخلية التي تليها مع ملاحظة أن لا تتكرر القيم يعني لو تمت الإضافة اذا كانت القيمة موجودة لا تضاف تقبل شكري وتقديري رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 1, 2015 مشاركة قام بنشر ديسمبر 1, 2015 جرب التعديل التالي عله يفي بالغرض Sub Transfer() Dim Cel As Range, LR As Long For Each Cel In Sheets("main").Range("A2:A" & Sheets("main").Cells(Rows.Count, 1).End(xlUp).Row) If Evaluate("=ISREF('" & Cel.Value & "'!A1)") Then With Sheets("" & Cel.Value & "") LR = IIf(IsEmpty(.Range("A1")), 1, .Cells(Rows.Count, 1).End(xlUp).Row + 1) If Application.WorksheetFunction.CountIf(.Range("A1:A" & LR), Cel.Offset(0, 1).Value) >= 1 Then GoTo Skipper Sheets("" & Cel.Value & "").Range("A" & LR) = Cel.Offset(0, 1).Value End With End If Skipper: Next Cel End Sub Transfer Data To Proper Sheet Without Duplicates YasserKhalil.rar 1 رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 1, 2015 الكاتب مشاركة قام بنشر ديسمبر 1, 2015 اسأل الله سبحانه وتعالى أن يرزقك في الدنيا والآخرة سؤال أخير هذا الكود ينفع لأكثر من خليه بس أضيف أسماء الخلايا صحيح رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 1, 2015 مشاركة قام بنشر ديسمبر 1, 2015 أخي الكريم يمكنك إضافة ما تشاء من خلايا ...على حسب ما فهمت من سؤالك حاول توضح أكتر المطلوب ..ودائماً ارفق شكل النتائج المتوقعة لتجد المساعدة من إخوانك بالمنتدى رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 1, 2015 الكاتب مشاركة قام بنشر ديسمبر 1, 2015 بارك الله فيك المرفق يوضح مااقصده Transfer Data To Proper Sheet Without Duplicates YasserKhalil.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 2, 2015 مشاركة قام بنشر ديسمبر 2, 2015 يرجى توضيح النقطة الثانية في المرفق ويرجى التوضيح بشكل عام في المشاركة أولاً .. بالنسبة لنقل السجل بالكامل أمره بسيط .. ماذا بالنسبة للتكرار (عدم نقل القيمة في حالة تكرار أي عمود : القيمة أم الاسم أم التاريخ أم العمر؟؟) رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 2, 2015 الكاتب مشاركة قام بنشر ديسمبر 2, 2015 صباح الخير استاذي الفاضل عدم نقل القيمة في حال تكرار القيمة والتاريخ النقطة الثانية مطلوب أن تكون قيمة الخلية أخر قيمة في العمود واسعد الله ايامك بكل خير رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 2, 2015 مشاركة قام بنشر ديسمبر 2, 2015 هل تقصد أن يكون عمود القيمة في بقية الأوراق في آخر الأعمدة وليس كما في المرفق في أول عمود وضح بمرفق فيه شكل النتائج المتوقعة بارك الله فيك رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 2, 2015 الكاتب مشاركة قام بنشر ديسمبر 2, 2015 تم التوضيح في المرفق وفقك الله Transfer Data To Proper Sheet Without Duplicates YasserKhalil.rar رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 2, 2015 الكاتب مشاركة قام بنشر ديسمبر 2, 2015 لا أدري استاذي هل وصلت المعلومة رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 2, 2015 مشاركة قام بنشر ديسمبر 2, 2015 Sub TransferToAllSheets() 'Author : YasserKhalil 'Released : 02 - Dec. - 2015 'Use : The Code Transfers Data In Column B To Its Proper Sheet In A ' If Value Found In The Target Sheet, It Won't Be Transferred. '------------------------------------------------------------------------- Dim Cel As Range Dim LR As Long With Application .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual End With For Each Cel In Sheets("Main").Range("A2:A" & Sheets("Main").Cells(Rows.Count, 1).End(xlUp).Row) If Evaluate("=ISREF('" & Cel.Value & "'!A1)") Then With Sheets("" & Cel.Value & "") LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 If Application.WorksheetFunction.CountIfs(.Range("A2:A" & LR), Cel.Offset(0, 1), .Range("C2:C" & LR), Cel.Offset(0, 3)) Then GoTo Skipper .Range("A" & LR).Resize(, 4).Value = Cel.Offset(0, 1).Resize(, 4).Value Cel.Offset(0, 10) = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row) End With End If Skipper: Next Cel With Application .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic End With End Sub Sub ClearAllSheets() Dim WS As Worksheet For Each WS In ThisWorkbook.Sheets If WS.Name <> "Main" Then WS.Range("A2:D1000").ClearContents Next WS Sheets("Main").Range("K2:K1000").ClearContents End Sub أخي الكريم جرب التعديل بالشكل التالي عله يفي بالغرض إليك الملف المرفق فيه ما تطلب إن شاء الله Transfer Data To Proper Sheet Without Duplicates YasserKhalil V2.rar 1 رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 2, 2015 الكاتب مشاركة قام بنشر ديسمبر 2, 2015 رائع بارك الله فيك ووفقك في الدنيا والآخرة 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 2, 2015 مشاركة قام بنشر ديسمبر 2, 2015 الحمد لله أن تم المطلوب على خير الحمد لله الذي بنعمته تتم الصالحات ومشكور على دعائك الطيب رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 3, 2015 الكاتب مشاركة قام بنشر ديسمبر 3, 2015 صباح الخير استاذي الفاضل بعد أن طبقت الكود على ملفي الرئيسي يعمل الكود بصورة رائعة جدا وحسب المطلوب الا انه عند الانتهاء يعطيني رساله مفاده run time error 13 type mismatch ويحولني على صفحة الكود ويعلم على السطر التالي باللون الأصفر If Evaluate("=ISREF('" & Cel.Value & "'!A1)") Then رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 3, 2015 مشاركة قام بنشر ديسمبر 3, 2015 ضع قبل هذا السطر سطر لتخطي الخطأ On Error Resume Next رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 3, 2015 الكاتب مشاركة قام بنشر ديسمبر 3, 2015 تسلم وتدوم الف شكر لك وسرعة تجاوبك ومساعدتنا كتب الله لك الأجر والعافية رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 5, 2015 الكاتب مشاركة قام بنشر ديسمبر 5, 2015 السلام عليكم صباح الخير استاذي الفاضل ادري اني زودتها ولكن كرمكم يجعلني اتسأل باستمرار في كودك السابق نقل السجلات إلى الأوراق حبيت أضيف له أمر عند كل نقل يتم مسح أول سجل في الورقة عشان ما يكون الملف في سجلات مالها داعي يعلم الله حاولت دون فائدة بارك الله فيك رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 5, 2015 الكاتب مشاركة قام بنشر ديسمبر 5, 2015 للتذكير سبحان الله وبحمده رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 5, 2015 الكاتب مشاركة قام بنشر ديسمبر 5, 2015 السلام عليكم صباح الخير استاذي الفاضل ادري اني زودتها ولكن كرمكم يجعلني اتسأل باستمرار في كودك السابق نقل السجلات إلى الأوراق حبيت أضيف له أمر عند كل نقل يتأكد أذا عدد السجلات 355 يتم مسح أول سجل في الورقة عشان ما يكون الملف في سجلات مالها داعي يعلم الله حاولت دون فائدة بارك الله فيك رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 6, 2015 الكاتب مشاركة قام بنشر ديسمبر 6, 2015 الأستاذ / ياسر خليل مختفي أن شاء الله يكون المانع خير رابط هذا التعليق شارك More sharing options...
أبو وليد قام بنشر ديسمبر 8, 2015 الكاتب مشاركة قام بنشر ديسمبر 8, 2015 سبحان الله وبحمده رابط هذا التعليق شارك 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.