ناصرالمصرى قام بنشر مارس 17, 2021 مشاركة قام بنشر مارس 17, 2021 (معدل) السلام عليكم ورحمة الله وبركاته كيف يمكن نسخ نطاقين مختلفين من ورقة عمل الى ورقه أخرى بنفس التنسيقات تحتوى ورقة البيانات فى المرفق على النطاق من العمود A الى العمود J حيث أرغب فى نسخ نطاق العمود A من ورقة البيانات الى العمود A فى ورقة الهدف ونطاق الأعمدة من العمود B الى العمود J من ورقة البيانات الى نطاق الأعمده من J الى العمود R فى ورقة الهدف لمزيد من التوضيح يُرجى الإطلاع على المرفق التالى وجزاكم الله خير الجزاء Book1.rar تم تعديل مارس 17, 2021 بواسطه ناصرالمصرى رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مارس 18, 2021 مشاركة قام بنشر مارس 18, 2021 اسماء الصفحات باللغة الأجنبية (ثم ما هذه الحجم الهائل للملف 11.5 ميغا) تم تحجيمة الى 80 كيلو فقط Option Explicit Sub Form_To() Dim F As Worksheet, W As Worksheet Dim max_ro%, max_col% Set F = Sheets("From") Set W = Sheets("Where") max_ro = F.Cells(Rows.Count, 1).End(3).Row max_col = F.Cells(8, Columns.Count).End(1).Column W.Cells(8, 1).Resize(max_ro - 7).Value = _ F.Cells(8, 1).Resize(max_ro - 7).Value W.Cells(8, "j").Resize(max_ro - 7, max_col - 1).Value = _ F.Cells(8, 2).Resize(max_ro - 7, max_col - 1).Value End Sub Naser.xlsm رابط هذا التعليق شارك More sharing options...
ناصرالمصرى قام بنشر مارس 18, 2021 الكاتب مشاركة قام بنشر مارس 18, 2021 جزاكم الله خيرا أستاذى الفاضل الكود يعمل بشكل جيد من حيث المبدأ ولكن بدون روؤس الأعمده فضلا عن أنه لا ينسخ نفس التنسيقات من ورقة From " المصدر " الى ورقة Where " الهدف " كنوع الخط وحجم الخط وارتفاع الصف وعرض العمود وما إلى ذلك من التنسيقات فكيف السبيل لتحقيق ذلك ؟ رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مارس 18, 2021 مشاركة قام بنشر مارس 18, 2021 نعديل الكود (نفس النتسيق) اكنب رؤوس الأعمدة التي تريدها في الصف رقم 8 Option Explicit Sub Form_To() Dim F As Worksheet, W As Worksheet Dim max_ro%, max_col% Set F = Sheets("From") Set W = Sheets("Where") max_ro = F.Cells(Rows.Count, 1).End(3).Row max_col = F.Cells(8, Columns.Count).End(1).Column With W.Cells(8, 1) .CurrentRegion.Clear .Offset(, 9).CurrentRegion.Clear F.Cells(8, 1).Resize(max_ro - 7).Copy .PasteSpecial F.Cells(8, 2).Resize(max_ro - 7, max_col - 1).Copy .Offset(, 9).PasteSpecial End With Application.CutCopyMode = False End Sub Naser_1.xlsm 2 رابط هذا التعليق شارك More sharing options...
ناصرالمصرى قام بنشر مارس 18, 2021 الكاتب مشاركة قام بنشر مارس 18, 2021 (معدل) جزاكم الله خيرا وبارك فيكم بقيت نقطة التنسيقات لم تضبط بعد فهل من سبيل أخر وافر تقديرى واحترامى تم تعديل مارس 18, 2021 بواسطه ناصرالمصرى خطأ إملائى رابط هذا التعليق شارك More sharing options...
هشام جودي قام بنشر ديسمبر 7, 2021 مشاركة قام بنشر ديسمبر 7, 2021 السلام عليكم عمل ممتاز جدا بورك فيكم رابط هذا التعليق شارك 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.