محمد الحضري قام بنشر يناير 30, 2023 مشاركة قام بنشر يناير 30, 2023 الساده الكرام بعد التحيه لجميع اعضاء المنتدى ارجو المساعده فى صياغه كود لحفظ قيم شيت اكسيل مع التنسيقات وتصديرها الى شيت جديد منفصل بصيغة XLSX بدون مايحفظ المعادلات ( يحفظ القيم والتنسيقات فقط ) مع تحديد الخلايا المراد حفظها مثلا من خلية A1 الى الخلية L50 جزاكم الله الف خير رابط هذا التعليق شارك More sharing options...
أبو إيمان قام بنشر يناير 31, 2023 مشاركة قام بنشر يناير 31, 2023 فضلا ارفق مثال رابط هذا التعليق شارك More sharing options...
أفضل إجابة lionheart قام بنشر يناير 31, 2023 أفضل إجابة مشاركة قام بنشر يناير 31, 2023 Try this code Sub Test() Dim wb As Workbook, ws As Worksheet, sh As Worksheet, r As Range Set ws = ActiveSheet Set r = ws.Range("A1:L50") Set wb = Application.Workbooks.Add With wb Set sh = .Worksheets(1) r.Copy sh.Range("A1") sh.Range(r.Address).Value = sh.Range(r.Address).Value Application.DisplayAlerts = False .SaveAs ThisWorkbook.Path & "\Output", 51 Application.DisplayAlerts = True .Close 0 End With End Sub 2 1 رابط هذا التعليق شارك More sharing options...
محمد الحضري قام بنشر يناير 31, 2023 الكاتب مشاركة قام بنشر يناير 31, 2023 جزاكم الله الف خير الكود شغال ولكن ينقصه الحفظ بالتنسيقات الاساسية للملف الاصل رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر يناير 31, 2023 مشاركة قام بنشر يناير 31, 2023 Are you sure? Did you try the code well If the code doesn't work well, please attach a file to have a look رابط هذا التعليق شارك More sharing options...
محمد الحضري قام بنشر يناير 31, 2023 الكاتب مشاركة قام بنشر يناير 31, 2023 الكود يعمل بشكل جيد وممتاز جداً لكن المشكله الحالية في التنسيقات الملف الاصلي يوجد فيه تنسيقات معينة تخلتف مقاسات الصفوف والاعمدة في حال التصدير تكون مقاسات الشيت الجديد القياسات الافتراضية المطلوب يكون نفس تنسيقات الملف الاصلي رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر فبراير 1, 2023 مشاركة قام بنشر فبراير 1, 2023 Attach sample of your file رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر فبراير 1, 2023 مشاركة قام بنشر فبراير 1, 2023 Try this version Sub Test() Const iFirstRow As Long = 1, iFirstColumn As Long = 1, iLastRow As Long = 20, iLastColumn As Long = 5 Dim wb As Workbook, ws As Worksheet, r As Range Application.ScreenUpdating = False Application.DisplayAlerts = False Set ws = ActiveSheet Set r = ws.Range(ws.Cells(iFirstRow, iFirstColumn), ws.Cells(iLastRow, iLastColumn)) Set wb = Workbooks.Add(xlWBATWorksheet) With wb ws.Copy Before:=.Worksheets(1) .Worksheets(2).Delete With .Worksheets(1) .Range(r.Address).Value = .Range(r.Address).Value .Rows(iLastRow + 1 & ":" & .Rows.Count).Delete .Columns(iLastColumn + 1).Resize(, .Columns.Count - iLastColumn).Delete .Name = ws.Name End With .SaveAs ThisWorkbook.Path & "\Output", 51 .Close 0 End With Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Done", 64 End Sub Change the first line in the code to suit the range you desire. In my case this range is A1 to E20 1 رابط هذا التعليق شارك More sharing options...
محمد الحضري قام بنشر فبراير 1, 2023 الكاتب مشاركة قام بنشر فبراير 1, 2023 ممتاز جداً لكن الكود لا يعمل اثناء حماية ورقة العمل يتطلب فتح حماية الشيت كي يعمل الكود رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر فبراير 1, 2023 مشاركة قام بنشر فبراير 1, 2023 I will not work on that topic till you attach a file. That's waste of time رابط هذا التعليق شارك More sharing options...
محمد الحضري قام بنشر فبراير 1, 2023 الكاتب مشاركة قام بنشر فبراير 1, 2023 مرفق الملف test.rar رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان