نقل ورقة اكسل إلى ملف مستقل

[essam rabea]

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

عندى جدول ما فى صفحة رقم 1 من ملف اكسيل(مكون من صفحتين) ياخذ بياناته من صفحة رقم 2 والتى تحتوى على بعض المعادلات .. وفوجئت بان حجم الملف اصبح كبير بدرجة عالية ..

وما اريده هو عمل زر امر ينشىء ملف اكسيل جديد فى نفس المسار الحالى للملف المفتوح وينسخ فيه الجدول من الصفحة رقم 1 وبالتالى يقل حجمه لإرسالة بالإيميل.

هل اجد عندكم الحل؟

وبارك الله فيكم .. شكرا

[محمد حجازي]

السلام عليكم ...

جرب الكود التالي:

Public NewWorkbok As Object
Sub SaveSheet()
Dim MyPath As String
Dim NumberSheets() As Integer
MyPath = Workbooks("MAH").Path & "\MAH_TEST"
Set NewWorkbok = Workbooks.Add
Workbooks("MAH").Sheets(1).Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1)
ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count)
For i = 2 To NewWorkbok.Worksheets.Count
   NumberSheets(i) = i
Next i
Application.DisplayAlerts = False
With NewWorkbok
  .Sheets(NumberSheets).Delete
  .SaveAs Filename:=MyPath
  .Close
End With
Application.DisplayAlerts = True
End Sub

ولكن انتبه إلى أن الكود يحفظ الصفحة الأولى الموجودة في المصنف MAH في مصنف جديد اسمه MAH_TEST

بالتوفيق

تم تعديل فبراير 4, 2005 بواسطه محمد حجازي

[محمد حجازي]

السلام عليكم ...

ومن أجل حفظ الصفحة بدون ارتباطات مع الملف الأساسي إليك الكود التالي:

Public NewWorkbok As Object
Sub SaveSheet()
Dim MyPath As String
Dim NumberSheets() As Integer
MyPath = Workbooks("MAH").Path & "\MAH_TEST"
Set NewWorkbok = Workbooks.Add
Workbooks("MAH").Sheets(1).Copy Before:=Workbooks(NewWorkbok.Name).Sheets(1)
ReDim NumberSheets(2 To NewWorkbok.Worksheets.Count)
For i = 2 To NewWorkbok.Worksheets.Count
   NumberSheets(i) = i
Next i
Application.DisplayAlerts = False
With NewWorkbok
  .Sheets(NumberSheets).Delete
  .Sheets(1).Cells.Copy
  .Sheets(1).Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
  .Sheets(1).Cells(1, 1).Select
  .SaveAs Filename:=MyPath
  .Close
End With
Application.DisplayAlerts = True
End Sub

تم تعديل فبراير 4, 2005 بواسطه محمد حجازي

[essam rabea]

بارك الله فيك وعليك كله تمام يا باشا