علي بن علي

استاذي الفاضل محمد الكود يعمل بطالطريقة المطلوبه ولكن بعد المعاينه والطباعه تختفي بقية الاعمده الغير مطلوبه المطلوب استاذي الفاضل ان لا تختفي الاعمده نهائيا سوا قبل الطباعه او بعدها ولك جزيل الشكر

استاذي الفاضل سوف ارفق لك ملفين للفكره التي اطلبها وارجو ان يطبق ما فيها على الشيت الخاص بي وانا اطلب طباعة الاعمده المحدده وليس الصفوف اتمنى استاذي الكريم تبسيط الكود لا يتناسب مع ملفي . وكذلك لمقدرتي لنقله الى ملفي الملفات المرفقهطباعة اعمدة محددة مع صفوف اعتمادا على قيمة نصية+111.xlsb (1).rarطباعة اعمدة محددة مع صفوف اعتمادا على قيمة نصية+111.xlsb.rar

استاذي الفاضل محمد المطلوب طباعة الاعمده الصفراء فقط المظلله في الجدول فقط حيث عند الضغط على زر المعاينه تظهر للطباعة الاعمده الصفراء فقط وعند الخروج من المعاينه تظهر جميع الاعمده كما كانت قبل الطباعه والمشكله اني لا اريد اخفاء الاعمده اريدها كلها ظاهره وعند الطباعه فقط تظهر الاعمده الصفراء وعند الخروج من المعاينه والطباعه تظهر جميع الاعمده كما كانت . بدون اخفاء للأعمدة

اساتذتنا الكرام السلام عليكم ورحمة اله وبركاته ارفع اليكم هذا الشيت وارجو المساعده بطباعة اعمده محدده بقية الشرح والتوضيح للمطلوب داخل الشيت طباعة اعمده محدده.xlsx

السلام عليكم وبها نبدأ للخبراء تعديل هذا الكود في الملف المرفق ولكن بشرط عند الترحيل لا ينسخ المعادلات الى الشيت الجديد المرحل اليه بمعنى أوضح يرحل القيم فقط ودمتم بخير وعافيه مرفق ملف به الكود كاملا HOUS() Dim sh As Worksheet Dim nm Dim x, lr Dim arr Dim ws As Worksheet: Set ws = Sheets("ÔåÑ 8") Application.ScreenUpdating = False x = InputBox("ÇÏÎá ÇÓã ÇáÔíÊ ÇáÐí ÓíÖÇÝ") If x = "" Then MsgBox "ÇÏÎá ÇÓã ÇáÔíÊ ÇæáÇ", vbExclamation: Exit Sub For Each sh In Sheets If x = sh.Name Then MsgBox "åÐÇ ÇáÇÏÎÇá ãæÌæÏ Öãä ÇÓãÇÁ ÇáÔíÊÇÊ", vbExclamation Exit Sub End If Next sh Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = (x) Set nm = Sheets(x) nm.DisplayRightToLeft = True Sheets("Data").Range("B1:af1").Copy nm.Range("B1").PasteSpecial nm.Range("B1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False lr = ws.Cells(Rows.Count, 2).End(xlUp).Row ws.Range("B1:af" & lr).Copy nm.Range("B1") الرجاء المساعده (1).xlsm