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

هل ممكن نسخ شيتات من ملف محمي إلى ملف آخر


إذهب إلى أفضل إجابة Solved by نبيل عبد الهادي,

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

السلام عليكم

طابت أوقاتكم يا سادة

باختصار عندي ملف أحتاجه مع ثلاثين قسم في عملي في كل شهر

الملف الذي يصلني من الأقسام عليه باسوورد حماية (123)ـ 

أحتاج أنسخ ثلاث شيتات من الملف المحمي

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

الأولى: الماكرو ما يكتب الباسوورد فأضطر لفتح الملف وفك الباسوورد قبل تفعيل الماكرو

الثانية: لازم يبقى الملف في نفس المسار ، وأنا أتمنى يكون فولدر لكل شهر

 

الشيتات التي أريد نسخها من ملف باسم رقم واحد في فولدر Files إلى ملف HR_TESTER

file_2020-02-22_040033.png (464×157)

Shift Schedule & Overtime & Attendance

 

 

file_2020-02-22_043706.png (834×528)

 

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

HR_TESTER.xlsm 1.xlsm

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

وعليكم السلام-يمكنك تطويع هذا الكود

Option Explicit
Option Base 1

Sub Wsh_CopyTo_NewWbk()
Dim aWsh As Variant
aWsh = [{"Sheet1","Wsh1";"Sheet2","Wsh2"}]
Dim aWshSrc(2) As Worksheet
Dim wbk As Workbook, wsh As Worksheet
Dim vItm As Variant, b As Byte

    Rem Set Worksheet Array
    With ThisWorkbook
        For b = 1 To UBound(aWsh)
            .Worksheets(aWsh(b, 1)).Unprotect Password:=aWsh(b, 2)
            Set aWshSrc(b) = .Worksheets(aWsh(b, 1))
    Next: End With

Rem Add New Workbook
    Set wbk = Workbooks.Add
    With wbk
        Rem Delete All Worksheets but One
        Application.DisplayAlerts = False
        For Each wsh In .Worksheets
            With wsh
                If .Index = 1 Then .Name = "!DELETE" Else .Delete
        End With: Next
        Application.DisplayAlerts = True

        Rem Copy Worksheets
        For Each vItm In aWshSrc
            vItm.Copy After:=Sheets(.Sheets.Count)
            Set wsh = .Sheets(.Sheets.Count)
            wsh.UsedRange.Value = wsh.UsedRange.Value2
        Next

        Rem Delete Reamining Worksheet
        Application.DisplayAlerts = False
        .Worksheets("!DELETE").Delete
        Application.DisplayAlerts = True

    End With
End Sub

 

  • Like 3
  • Thanks 1
رابط هذا التعليق
شارك

شكر الله لك وبارك في عمرك وصحتك ووقتك وعلمك .

أستاذي .. لا أجيد التعديل على الأكواد ، وعشان أعدل سطر يأخذ مني ساعة وغالبا ما تطلع النتيجة صحيحة

قبل ما أفتح الموضوع حاولت أيام في التعديل على الماكرو ما انحلت المشكلة

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

والذي أريده سحب الشيتات من ملف آخر إلى الملف الذي يكون فيه الكود

file_2020-02-22_043706.png (834×528)

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

  • أفضل إجابة

تفضل...

1- على اعتبار ان الملف 1.xlsm  في مجلد Files في القسم c

2- بعد انتهاء نقل الاوراق اختر "حفظ" اذا كنت لاتريد احتفاظ الملف الاصلي 1.xlsm بالاوراق المنقوله والعكس صحيح عند اختيار "عدم الحفظ"

3- يمكن لك نسخ الاوراق اكثر من مره الى ملف HR_TESTER

HR_TESTER.xlsm 1.xlsm

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

الأستاذ: نبيل عبدالهادي

جزاك الله خيراً ، ومتعك الله بصحتك وبارك في عمرك ووقتك وأدام لك السعادة

كفيت ووفيت ، هذا المطلوب << شكر من الأعماق ، ودعوة في آخر الليل 

كثر الله من أمثالك 

تحياتي

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information