جمال محمود محمد قام بنشر يوليو 18, 2016 مشاركة قام بنشر يوليو 18, 2016 السلام عليكم ورحمة الله أرجو المساعدة بكود نسخ أعمدة معينة من ورقة 1 لورقة 2 مرفق مثال أريد نقل E - F - I - A للورقة 2 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 18, 2016 مشاركة قام بنشر يوليو 18, 2016 وعليكم السلام أخي الكريم جمال يرجى تغيير اسم الظهور للغة العربية ، ويرجى إرفاق الملف رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يوليو 18, 2016 مشاركة قام بنشر يوليو 18, 2016 جرب هذا الملف ربما يكون المطلوب Copy_spec_col.rar رابط هذا التعليق شارك More sharing options...
جمال محمود محمد قام بنشر يوليو 18, 2016 الكاتب مشاركة قام بنشر يوليو 18, 2016 16 دقائق مضت, سليم حاصبيا said: صباح الخير أخى سليم ومشكور على الاستجابة بالنسبة للظهور يظهر بالانجليزي لانني أسجل دخول بالفيس بوك بالنسبة للملف المرفق أرجو المساعدة فى الاتى :- 1/ نقل بيانات Normal - Oil - Accident - Washing فقط الاعمدة من 3 الى 6 2/ يكون التسلسل تلقائي عند اضافة اى قيمة فى الخلية المقابلة 3/ اضافة عبارة تم التقدير فى العمود الاخير تلقائيا 16 دقائق مضت, سليم حاصبيا said: Test5.rar رابط هذا التعليق شارك More sharing options...
جمال محمود محمد قام بنشر يوليو 18, 2016 الكاتب مشاركة قام بنشر يوليو 18, 2016 فى انتظار الرد رابط هذا التعليق شارك More sharing options...
جمال محمود محمد قام بنشر يوليو 18, 2016 الكاتب مشاركة قام بنشر يوليو 18, 2016 فى انتظار الرد رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يوليو 18, 2016 مشاركة قام بنشر يوليو 18, 2016 تم العمل حسب المطلوب فقط اضغط (اعجاب) copy_rng.rar 3 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 18, 2016 مشاركة قام بنشر يوليو 18, 2016 أخي الكريم جمال محمود في ورقة العمل المسماة "All" قم بحذف الصفوف كلها بداية من الصف السادس إلى آخر صف .. وحول الجدول إلى نطاق عادي ثم ضع الكود التالي في موديول عادي ثم نفذ الأمر .. Sub YasserKhalil() Dim Ws As Worksheet, Sh As Worksheet Dim LR As Long, Last As Long Set Sh = Sheets("All") Application.ScreenUpdating = False Application.DisplayAlerts = False With Sh .Range("A6:G10000").Clear 'حلقة تكرارية لكل أوراق العمل لجلب البيانات من الأعمدة المحددة For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "All" Then LR = Ws.Cells(Rows.Count, 1).End(xlUp).Row Last = .Cells(Rows.Count, "B").End(xlUp).Row Ws.Range("E2:I" & LR).Copy .Range("B" & Last + 1).PasteSpecial xlPasteValues End If Next Ws Last = .Cells(Rows.Count, "B").End(xlUp).Row + 1 'وضع عبارة "تم التقدير" في العمود السابع .Range("G6:G" & Last).Value = "تم التقدير" 'ترقيم العمود الأول With .Range("A6:A" & Last + 1) .Formula = "=IF(B6="""","""",ROW()-5)" .Value = .Value End With 'دمج خلايا المجموع ووضع المعادلة في الخلايا المدمجة With .Range("A" & Last & ":B" & Last) .Merge .Value = "المجموع" End With With .Range("C" & Last & ":G" & Last) .Merge .Formula = "=SUM(F6:F" & Last - 1 & ")" End With 'تسطير جدول البيانات التي تم جلبها .Range("A5").CurrentRegion.Borders.Value = 1 'تنسيق نطاق البيانات With .Range("A5").CurrentRegion.Offset(1) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Bold = True End With End With Application.CutCopyMode = False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub في الكود يوجد بعض التعليقات التي تساعدك في فهم الكود تقبل تحياتي 3 رابط هذا التعليق شارك More sharing options...
جمال محمود محمد قام بنشر يوليو 19, 2016 الكاتب مشاركة قام بنشر يوليو 19, 2016 الاخوان الأفاضل سليم حاصبيا وياسر خليل أبو البراء لكم التحايا والتقدير على إستجابتكم السريعة لقد كنتم عند حسن ظنى بكم عندما طلبت مساعدتكم عاجز عن الشكر والتقدير وإن شاء الله فى ميزان حسناتكم قسما بالله قمة الابداع كل المطلوب وجدته فى إجاباتكم الشافية والتى سوف تساعدنى كثيرا فى مجال عملي لقد سهلتم لى العمل وتقليل الجهود التى كنت أبذلها فى سبيل إعداد هذا التقرير شكرا سليم شكرا ياسر ومزيدا من التقدم والازدهار 1 رابط هذا التعليق شارك More sharing options...
جمال محمود محمد قام بنشر يوليو 19, 2016 الكاتب مشاركة قام بنشر يوليو 19, 2016 18 ساعات مضت, ياسر خليل أبو البراء said: أخي الكريم جمال محمود في ورقة العمل المسماة "All" قم بحذف الصفوف كلها بداية من الصف السادس إلى آخر صف .. وحول الجدول إلى نطاق عادي ثم ضع الكود التالي في موديول عادي ثم نفذ الأمر .. Sub YasserKhalil() Dim Ws As Worksheet, Sh As Worksheet Dim LR As Long, Last As Long Set Sh = Sheets("All") Application.ScreenUpdating = False Application.DisplayAlerts = False With Sh .Range("A6:G10000").Clear 'حلقة تكرارية لكل أوراق العمل لجلب البيانات من الأعمدة المحددة For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "All" Then LR = Ws.Cells(Rows.Count, 1).End(xlUp).Row Last = .Cells(Rows.Count, "B").End(xlUp).Row Ws.Range("E2:I" & LR).Copy .Range("B" & Last + 1).PasteSpecial xlPasteValues End If Next Ws Last = .Cells(Rows.Count, "B").End(xlUp).Row + 1 'وضع عبارة "تم التقدير" في العمود السابع .Range("G6:G" & Last).Value = "تم التقدير" 'ترقيم العمود الأول With .Range("A6:A" & Last + 1) .Formula = "=IF(B6="""","""",ROW()-5)" .Value = .Value End With 'دمج خلايا المجموع ووضع المعادلة في الخلايا المدمجة With .Range("A" & Last & ":B" & Last) .Merge .Value = "المجموع" End With With .Range("C" & Last & ":G" & Last) .Merge .Formula = "=SUM(F6:F" & Last - 1 & ")" End With 'تسطير جدول البيانات التي تم جلبها .Range("A5").CurrentRegion.Borders.Value = 1 'تنسيق نطاق البيانات With .Range("A5").CurrentRegion.Offset(1) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Bold = True End With End With Application.CutCopyMode = False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub في الكود يوجد بعض التعليقات التي تساعدك في فهم الكود تقبل تحياتي الاخ ياسر خليل أبو البراء لك التحية هذا الكود فى حالة النسخ من جميع اوارق العمل فكيف الحال فى حال أحتجت النسخ من ورقتين او ثلاث فقط مع خالص شكري وتقديري رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يوليو 19, 2016 مشاركة قام بنشر يوليو 19, 2016 غير سطر الحلقة التكرارية إلى السطر التالي لتحدد الأوراق المطلوبة For Each Ws In Worksheets(Array("Washing", "Accident")) 1 رابط هذا التعليق شارك More sharing options...
جمال محمود محمد قام بنشر يوليو 19, 2016 الكاتب مشاركة قام بنشر يوليو 19, 2016 23 دقائق مضت, ياسر خليل أبو البراء said: غير سطر الحلقة التكرارية إلى السطر التالي لتحدد الأوراق المطلوبة For Each Ws In Worksheets(Array("Washing", "Accident")) تسلم الايادي الف الف شكر 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان