طلب تعديل فى كود ترحيل الصفحات لملفات منفصله

[إبراهيم محمد]

بسم الله الرحمن الرحيم 

الاساتذة الافاضل  

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

والمطلوب هو اضافه فى الكود تعمل على حذف العمودين b , c  من الملفات الناتجه  مع ترك النسخه الاصليه كما هى 

هذا وتفضلوا بقبول وافر الاحترام والتقدير 

 

ترحيل صفحات الى ملفات منفصله.rar

 

 

[احمد عبد الناصر]

السلام عليكم

 

جرب هذا التعديل

 

 With wo   
                .Sheets(Sht).Range("b:c").Delete
                .SaveAs iPath & Sht
                .Close False
            End With

 

 

 

تحياتي

ترحيل صفحات الى ملفات منفصله+.rar

[بن علية حاجي]

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

 

أخي الكريم إبراهيم، تم المطلوب حسب ما فهمت... أرجو أن يفي هذا التعديل الطفيف على الكود...

 

أخوك بن علية

 

ترحيل صفحات الى ملفات منفصله.rar

تم تعديل مارس 5, 2013 بواسطه بن علية حاجي

[إبراهيم محمد]

الاستاذ الفاضل  / بن علية حاجي 

خالص الشكر والتقدير  فعلا هذا هو ما احتاجه  بارك الله فيك وجزاك الله خيرا 

 

الاخ الفاضل  / احمد عبد الناصر 

اسعدني مرورك الكريم وفيه اثراء للموضع  واكثر من طريقه للحل 

بارك الله فيك 

وهذا هو المنتدي الكريم كما تعودت دائما فيه خير الصحبه وخير اهل العلم 

[عبدالله المجرب]

وهذا تعديل للكود كنت قد اشتغلت عليه

وكل الشكر للاستاذين بن عليه واحمد عبد الناصر

 

Private Sub Cmd_action_Click() ' هذا الكود من اعداد الاستاذ  عبد الله باقشير

Dim iPath As String, Sht As String
Dim wo As Workbook
'''''''''''''''''''''''
iPath = ActiveWorkbook.Path & Application.PathSeparator
'''''''''''''''''''''''
With Me.ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            Sht = .List(i)
            Worksheets(Sht).Copy
            Set wo = ActiveWorkbook
            '''''''''''''''''''''''''''''''''''''
            '      : ??? ????? ???????

            With wo   '  مطلوب فى الملفات الناتجه  حذف العمودين  بي و سي  فقط ثم حفظ الملف
                .SaveAs iPath & Sht & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
           .ActiveSheet.Columns("B:C").Delete
           .Save
            .Close False
            End With
            '''''''''''''''''''''''''''''''''''''
        End If
    Next
End With
Set wo = Nothing

 MsgBox "تم حفظ الصفحات المحددة فى ملفات منفصله "
End Sub