طريقة استبدال المسار بنافذة اختيار ملف في الإكسل VBA

[Aibrahim1]

السلام عليكم 

لو سمحتم انا الكود التالي بيقوم بفتح ملف معين تم تحديد مساره مسبقا وعمل نسخ لمدى معين من الخلايا ولصقه في الملف الحالي

المطلوب هو استبدال المسار المحدد مسبقا بنافذه اختار منها أنا الملف لكي اتمكن من تغيير الملف الذي سوف يتم نسخ الخلايا منه في كل مرة مع العلم ان مدى الخلايا مش هيتغير في اي ملف من اللي بيتم اختيارهم.

 

Sub Update_Riyadh_Store()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range

Set wb1 = ActiveWorkbook
Set PasteStart = Sheets("Riyadh Stock").Range("A1")

Application.ScreenUpdating = False

'sheets and range to be updated'

Sheets("Riyadh Stock").Select
    Range("A1:F2500").Select
    Selection.ClearContents
    Sheets("Riyadh Stock").Range("A31").Select

FileToOpen = "C:\Users\ozohair\Desktop\Stocks\Riyadh Stock.xls"

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)

    For Each Sheet In wb2.Sheets
        With Sheet.UsedRange
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet
    
Application.ScreenUpdating = True

End If

    wb2.Close
    
    
    MsgBox "Stock has been updated successfully.", vbOKOnly, "Updated Successfully"

End Sub

 

[omar elhosseini]

شاهد المرفقان

 

 

Test_1.rar

[علي الشيخ]

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

لو شغلت الكود تاني وفتحت نافذة اختيار الملفات وضغطت كانسل بيكمل هو وينسخ نفس اللي كان في الملف الأول.

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

وشكرا مقدما لحضرتك

[omar elhosseini]

الملف بالمسار الخاص بك

 

 

 

Test_21.xls

[Aibrahim1]

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