نسخ بيانات عمود من ملف يتغير حسب الاختيار من قائمة

[ريان أحمد]

السلام عليكم

عندي شيئين أريد أن أبحث عنهم ولا أضنهم يهونون عليكم فانت ذوي الخبرة

أول شيء في المرفق

ثاني شيء هو أنني أريد في مكان إسم الملف في الماكرو المرفق يكون مرن أي أن أغير إسم الملف في الماكرو تبعا لخلية معينة

وإسم الملف tahar1983

تساؤل.rar

[عبد الفتاح كيرة]

تفضل

شرطkemas.rar

[ريان أحمد]

شكرا اخي على الرد وعلى المرور السريع

تقبل تحياتي الخالصة نعم وكالعادة متألق و متميز و مبدع

نعم هذا هو المطلوب

لكن لم جبني على التساؤل الثاني الى وهو انه عندي ماكرو يقوم بفتح ملف اكسل في درايفر c اسمه p4 و يقوم بنسخ العمود d الى ملف اسمه tahar

المطلوب

الملف p4 يتغير بدلالة الأشهر اي عند دخول شهر 5 يبقى الملف p4 و يأتني ملف جديد

اريد عمل ثلاث خلايا تدخل فيهم إسم الملف p4 المتغير واسم الدرايفر واسم الملف المستقبل

[ريان أحمد]

السلام عليكم

أين الردود

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

[عبد الفتاح كيرة]

أخى العزيز أرفق مثالا للمطلوب الثانى

عسى أن نجد الوقت لمساعدتك بإذن الله

[ريان أحمد]

قم بنسخ الملف tahar إلى لدرايف c

ثم إفتح الملف tahar2 الدي يحتوي على الماكرو وهناك تعرف ما أريد;

وشكرا على الإهتمام والردود

tahar.rar

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

اخي طاهر

وبعد اذن الاستاذ الفاضل خبور حفظه الله ورعاه

تفضل المرفق وهي طريقة تعلمتها من الاستاذ الفاضل عادل حنفي حفظه الله ورعاه

ان شاء الله يكون هذا ما تريد

tahar.rar

[عبدالله باقشير]

السلام عليكم

في الخلية "C1" اسم الدرايفر

في الخلية "D1" اسم المجلد

وممكن يتفرع الى عدة مجلدات

حينها ضع الشرطة "\" بين اسماء المجلدات

مثلا : "MyDocument\tahar"

في الخلية "C16" اسم ملف الاكسل

واسماء الملفات تكون ارقام عادية بدون اضافة اصفار قبل الرقم

وهذاالكود ادناه:

Option Explicit

Option Compare Text



Sub kh_copy_mydate()

'On Error Resume Next

    Dim sh As Worksheet

    Dim MyFilOpen As String, MyPath As String, MyBook As String

    '=====================

    Set sh = ActiveWorkbook.Worksheets(ActiveSheet.Name)

    Application.ScreenUpdating = False

    '=====================

    With sh

        MyPath = CStr(.Range("C1")) & ":\" & CStr(.Range("D1")) & "\"

        MyBook = CStr(.Range("C16")) & ".xls"

    End With

    '=====================

    MyFilOpen = MyPath & MyBook

    '=====================

    If Dir(MyFilOpen, vbDirectory) = vbNullString Then

        MsgBox "error"

    Else

        Workbooks.Open Filename:=MyFilOpen

        Sheets(1).Select

        Columns("A:A").Copy sh.Range("A1")

        Workbooks(MyBook).Close False

    End If

    '=====================

    Application.ScreenUpdating = True

    Set sh = Nothing

'On Error GoTo 0

End Sub

تفضل المرفق اكسل 2003

tahar1.rar

[عبدالله باقشير]

السلام عليكم

اخي الحبيب/ ولد المجرب -------- حفظه الله

حين وضعت ردي هنا

لم اشاهد ردك على الموضوع الفرعي

بارك الله فيك

وقد قمت بدمج الموضوعين هنا

وغيرت العنوان

ودمتم في حفظ الله

[احمد فضيله]

الاخ الحبيب / خبور خير

بسم الله ما شاء الله .. دائما مميز و رائع

بارك الله فيك و جزاك الله عنا خير الجزاء .. و جعلك دائما عونا للمسلمين

[ريان أحمد]

السلام عليكم

أخي وأستاذي خبور وولد مجرب نعم وبلا شك هو المطلوب ودائما والكعادة متألقين ومتميزين ومبدعين

يعجز اللسان عن الشكر ونفذت منا كل كلمات الشكر والإمتنان

ماذا عسانا أن نقول سوى جزاكم الله كل خير وجعلها في ميزان حسناتكم

بارك الله فيكم ولا نملك سوى الدعاء في ضهر الغيب

لا نستثني أحدا ولا نضيق واسعا