فصل وتصدير وحفظ كل أوراق العمل (الشيتات) في ملفات أكسل منفصلة بواسطة الوحدات النمطية (ماكرو)

[maxstreets]

السلام عليكم ورحمة الله وبركاته

سيقوم هذا الماكرو بتصدير كل ورقة عمل مرئية في مصنف جديد وحفظ المصنف باسم الورقة الأصلية في مجلد تم إنشاؤه حديثًا في نفس المسار مثل المصنف النشط. يرجى القيام كخطوات التالية:

الخطوة 1: اضغط باستمرار على المفاتيح ALT + F11 ، ويقوم بفتح Microsoft Visual Basic .

الخطوة 2: انقر فوق إدراج> الوحدة النمطية ، ثم قم بلصق الماكرو التالي في "إطار الوحدة النمطية":

 

Sub SplitWorkbook()

'Updateby20140612

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim xWs As Worksheet

Dim xWb As Workbook

Dim FolderName As String

Application.ScreenUpdating = False

Set xWb = Application.ThisWorkbook

DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")

FolderName = xWb.Path & "\" & xWb.Name & " " & DateString

MkDir FolderName

For Each xWs In xWb.Worksheets

    xWs.Copy

    If Val(Application.Version) < 12 Then

        FileExtStr = ".xls": FileFormatNum = -4143

    Else

        Select Case xWb.FileFormat

            Case 51:

                FileExtStr = ".xlsx": FileFormatNum = 51

            Case 52:

                If Application.ActiveWorkbook.HasVBProject Then

                    FileExtStr = ".xlsm": FileFormatNum = 52

                Else

                    FileExtStr = ".xlsx": FileFormatNum = 51

                End If

            Case 56:

                FileExtStr = ".xls": FileFormatNum = 56

            Case Else:

                FileExtStr = ".xlsb": FileFormatNum = 50

        End Select

    End If

    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr

    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum

    Application.ActiveWorkbook.Close False

Next

MsgBox "You can find the files in " & FolderName

Application.ScreenUpdating = True

End Sub

 

الخطوة 3: اضغط المفتاح F5 لتشغيل هذا الرمز (تجربة )  . وسيظهر مربع مطالبة لإخبارك بموقع المصنفات الجديدة التي تم تصديرها ، حيث تم تصدير كافة أوراق العمل الخاصة بالمصنف الأصلي إلى بعض المصنفات المنفصلة الجديدة التي تسمى أوراقًا أصلية في مجلد محدد جديد. 

الخطوة 4 : أربط الماكرو بأي زر في أي صفحة .

 

والسلام عليكم رحمة الله وبركاته.

 

[مهند محسن]

وعليكم السلام ولكن هناك مشكلة فى الكود هل لابد من عمل فولدر وتسميته بإسم معين فقد قمت بلصق الكود ولكنه لم يعمل معى ولم يقم بفصل الشيتات ممكن تجرب حضرتك ذلك 

بارك الله فيك وجزاك الله كل خير