sof17 قام بنشر April 1 مشاركة قام بنشر April 1 السلام عليكم أريد تغيير في هذا الكود بحيث يقوم بتصدير جميع الأوراق ما عدا الرئيسة في ملف واحد وليس كما هو في الكود ورقة واحدة فقط ويأخذ نفس إسم الملف تصدير أروق عمل.xls رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر April 2 مشاركة قام بنشر April 2 وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Sub split() Dim Wb As Workbook, Ws As Worksheet Dim F As Workbook, filePath As String, Cpt() filePath = Application.ActiveWorkbook.Path: Set Sh = Sheets(1) '("الرئيسية") With Application .ScreenUpdating = False .DisplayAlerts = False Set Wb = ActiveWorkbook: Set F = Workbooks.Add For Each Ws In Wb.Worksheets If Ws.Name <> Sh.Name Then n = n + 1 ReDim Preserve Cpt(1 To n) Cpt(n) = Ws.Name End If Next Ws Wb.Sheets(Cpt).Copy After:=F.Sheets(F.Sheets.Count) On Error Resume Next: F.Sheets(1).Delete: On Error GoTo 0 Application.ActiveWorkbook.SaveAs Filename:=filePath & "\" & Wb.Name & ".xlsx" F.Close .ScreenUpdating = True .DisplayAlerts = True End With End Sub تصدير أروق عمل.xls رابط هذا التعليق شارك More sharing options...
sof17 قام بنشر April 2 الكاتب مشاركة قام بنشر April 2 شكرا الأستاذ هشام وهو المطلوب سؤال : لماذ حذف الشيت 1 : F.Sheets(1).Delete: رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر April 2 مشاركة قام بنشر April 2 4 ساعات مضت, sof17 said: سؤال : لماذ حذف الشيت 1 ببساطة يمكنك الغاء السطر On Error Resume Next: F.Sheets(1).Delete: On Error GoTo 0 ومعاينة الملف بعد تنفيد الكود واختيار ما يناسبك 😉 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر April 3 مشاركة قام بنشر April 3 (معدل) بطريقة اخرى 17 ساعات مضت, sof17 said: سؤال : لماذ حذف الشيت 1 Sub split2() Dim sh As Worksheet, Cpt For Each sh In ThisWorkbook.Worksheets Set F = Sheets(1) If sh.Name <> F.Name Then Cpt = Cpt & "|" & sh.Name Next sh With Application .ScreenUpdating = False .DisplayAlerts = False Cpt = split(Mid(Cpt, 2), "|") Sheets(Cpt).Copy With ActiveWorkbook .SaveAs ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, _ InStrRev(ThisWorkbook.Name, ".") - 1) & ".xlsx", FileFormat:=51 .Close End With .ScreenUpdating = True .DisplayAlerts = True End With End Sub Or Dim sh As Worksheet, Cpt For Each sh In ThisWorkbook.Worksheets If sh.Name <> "الرئيسية" Then Cpt = Cpt & "|" & sh.Name Next sh تصدير أروق عمل.xls تم تعديل April 3 بواسطه محمد هشام. رابط هذا التعليق شارك More sharing options...
sof17 قام بنشر April 3 الكاتب مشاركة قام بنشر April 3 شكرا أستاذ هشام رابط هذا التعليق شارك 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.