sof17 قام بنشر أبريل 1, 2024 قام بنشر أبريل 1, 2024 السلام عليكم أريد تغيير في هذا الكود بحيث يقوم بتصدير جميع الأوراق ما عدا الرئيسة في ملف واحد وليس كما هو في الكود ورقة واحدة فقط ويأخذ نفس إسم الملف تصدير أروق عمل.xls
محمد هشام. قام بنشر أبريل 2, 2024 قام بنشر أبريل 2, 2024 وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا 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
sof17 قام بنشر أبريل 2, 2024 الكاتب قام بنشر أبريل 2, 2024 شكرا الأستاذ هشام وهو المطلوب سؤال : لماذ حذف الشيت 1 : F.Sheets(1).Delete:
محمد هشام. قام بنشر أبريل 2, 2024 قام بنشر أبريل 2, 2024 4 ساعات مضت, sof17 said: سؤال : لماذ حذف الشيت 1 ببساطة يمكنك الغاء السطر On Error Resume Next: F.Sheets(1).Delete: On Error GoTo 0 ومعاينة الملف بعد تنفيد الكود واختيار ما يناسبك 😉
محمد هشام. قام بنشر أبريل 3, 2024 قام بنشر أبريل 3, 2024 (معدل) بطريقة اخرى 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 تم تعديل أبريل 3, 2024 بواسطه محمد هشام.
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان