اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

حفظ ملف بأسم خلية متغيرة داخل الملف


oyousef

الردود الموصى بها

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

تحية طيبة لاساتذة المنتدى اللذين دائما احظى بمساعدتهم واتعلم منهم الكثير

وبعد

اود المساعده فى الاتى

اريد كود ينشئ نسخة من sheet 4 بالملف المرفق وتكون النسخة تحوى القيم والتنسيقات فقط ثم وضعها فى ملف اكسيل جديد وتحفظ على drive C بالاسم الموجود داخل الخليتان c4,d4 الموجدتان داخل sheet4 علما بان محتوى الخليتان المذكورتان متغير

مع خالص شكرى وامتنانى لكم وجزاكم الله كل الخير عن مساعدتكم لنا دوما :fff: :fff:

Return.rar

رابط هذا التعليق
شارك

FileFormat:=xlNormal

اخي الفاضل

جرب المرفق

سيتم حفظ نسخة طبق الاصل للشيت بما يحتويه sheet 4


Sub Abu_Ahmed()

On Error GoTo 10

	Sheets("Sheet4").Select

x = Range("C3").Value & " " & Range("D3").Value

	Sheets("Sheet4").Copy

	ChDir "C:\"

	ActiveWorkbook.SaveAs Filename:="C:\" & x & ".xls", FileFormat:=xlNormal, _

		Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

		CreateBackup:=False

	ActiveWindow.Close

	Range("H2").Select

10 End Sub

Return.rar

رابط هذا التعليق
شارك

اسف اخي الفاضل (الميكرو تم تسجيله على اكسل 2007) والنتيجة انه لم يعمل على 2003

تم استبدال الملف وتعديل الكود

جرب ان شاء الله سيعمل الان باذن الله

رابط هذا التعليق
شارك

السلام عليكم

جزاك الله خيراستاذ عبدالله المجرب

كود جميل

وربما هكذا


Sub copy_sh()

Dim F_FOL As String

  Application.ScreenUpdating = False

  F_FOL = "C:\"

  FName = Sheets("Sheet4").Range("c3").Text & " " & Sheets("Sheet4").Range("d3").Text

  With ActiveWorkbook

    Sheets("sheet4").Copy

    ActiveWorkbook.SaveCopyAs Filename:=F_FOL & FName & ".xls"

    ActiveWorkbook.Close False

    .Activate

  End With

  Application.ScreenUpdating = True

End Sub

رابط هذا التعليق
شارك

اخي يوسف هل جربي الملف (انا قمت باعادة رفعه)

الاخ الفاضل ابو احمد

لك منى كل الشكر وكل الاسف لانى ارهقتك ولكن

لقد قمت بتحميل الملف مره اخرى وجربته ولكنه لم يعمل ولما قمت باستعراض الكود اكتشفت انه لم يتغير

جزاك الله كل خير على مجهوداتك

رابط هذا التعليق
شارك

نعم اخي يوسف لم يتم تغيير جوهري في الكود

تم تغيير هذه الجزئية فقط


FileFormat:=xlNormal

وانا جربت الكود والكود يعمل عندي (ارجو ممن جرب ان يعلمنا بالنتيجة)

والله اعلم

رابط هذا التعليق
شارك

نعم اخي يوسف لم يتم تغيير جوهري في الكود

تم تغيير هذه الجزئية فقط


FileFormat:=xlNormal

وانا جربت الكود والكود يعمل عندي (ارجو ممن جرب ان يعلمنا بالنتيجة) والله اعلم

Sub acopyof()

'

    Dim FName		   As String

    Dim FPath		   As String


'Daily Movement file saving Path

    FPath = "C:\fr\supdata\FPDM"

    Sheets("sheet4").Select

    ActiveSheet.Copy

    Range("d3").Select


    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

	    :=False, Transpose:=False

    Application.CutCopyMode = False


    FName = Sheets("sheet4").Range("c3").Text & " " & Sheets("sheet4").Range("d3").Text


    ActiveWorkbook.SaveAs Filename:="C:\supData\Fr\" & FName


    Range("A4:f73").Select

    Selection.Copy

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

	    :=False, Transpose:=False

    Range("A1").Select

    Application.CutCopyMode = False

    ActiveSheet.Unprotect

    ActiveSheet.Shapes("Button 1").Select

    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2")).Select

    Selection.Delete

    End Sub

الاخ الفاضل ابو أحمد

لك منى كل شكر فالطالما كنت عونا لى

جزاك الله كل خير

حاولت اجرب الكود مرارا وتكرارا وجربت ان اغير فيه ولكن لم ينجح

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

وهذا هو الكود

واتمنى ان لا اكون اثقلت عليك

ولك منى كل الشكر

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information