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

[مداد_1423]

السلام عليكم

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

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

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

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

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

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

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

 

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

Shift Schedule & Overtime & Attendance

 

 

 

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

HR_TESTER.xlsm 1.xlsm

[Ali Mohamed Ali]

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

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

 

[مداد_1423]

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

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

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

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

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

[نبيل عبد الهادي]

تفضل...

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

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

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

HR_TESTER.xlsm 1.xlsm

[مداد_1423]

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

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

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

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

تحياتي