كيفية نسخ أو نقل الملفات من مجلد إلى آخر بناءً على قائمة في Excel؟
إذا كانت لديك قائمة بأسماء الملفات في عمود في ورقة العمل ، وتم تحديد موقع الملفات في مجلد في جهاز الكمبيوتر الخاص بك. ولكن ، الآن ، تحتاج إلى نقل أو نسخ هذه الملفات التي يتم سرد الأسماء في ورقة العمل من مجلدها الأصلي إلى مجلد آخر كما هو موضح في لقطة الشاشة التالية. كيف يمكنك إنهاء هذه المهمة بأسرع ما يمكن في Excel؟
انسخ الملفات أو انقلها من مجلد إلى آخر استنادًا إلى قائمة في Excel برمز VBA
انسخ الملفات أو انقلها من مجلد إلى آخر استنادًا إلى قائمة في Excel برمز VBA
لنقل الملفات من مجلد إلى آخر بناءً على قائمة بأسماء الملفات ، قد يكون رمز VBA التالي مفيدًا لك ، يرجى القيام بذلك على النحو التالي:
1. اضغط باستمرار على ALT + F11 في Excel ، ويفتح ملف ميكروسوفت فيسوال باسيك للتطبيقات نافذة.
2. انقر إدراج > وحدة، ولصق التعليمات البرمجية لـ VBA التالية في Module Window.
رمز فبا: نقل الملفات من مجلد إلى آخر بناءً على قائمة في إكسيل
Sub movefiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = " Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
For Each xCell In xRg
xVal = xCell.Value
If TypeName(xVal) = "String" And xVal <> "" Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
Kill xSPathStr & xVal
End If
Next
End Sub
3. ثم اضغط F5 مفتاح لتشغيل هذا الرمز ، وسيظهر مربع موجه لتذكيرك بتحديد الخلايا التي تحتوي على أسماء الملفات ، انظر لقطة الشاشة:
4. ثم اضغط OK زر ، وفي النافذة المنبثقة ، يرجى تحديد المجلد الذي يحتوي على الملفات التي تريد النقل منها ، انظر لقطة الشاشة:
5. ثم انقر فوق OK، استمر في تحديد مجلد الوجهة حيث تريد تحديد موقع الملفات في نافذة منبثقة أخرى ، انظر الصورة:
6. وأخيرا، انقر فوق OK لإغلاق النافذة ، والآن ، تم نقل الملفات إلى مجلد آخر حددته بناءً على أسماء الملفات في قائمة ورقة العمل ، انظر لقطة الشاشة:
ملاحظات: إذا كنت تريد فقط نسخ الملفات إلى مجلد آخر ، مع الاحتفاظ بالملفات الأصلية ، فالرجاء تطبيق رمز VBA أدناه:
رمز فبا: انسخ الملفات من مجلد إلى آخر بناءً على قائمة في Excel
Sub copyfiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = "Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = "Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
For Each xCell In xRg
xVal = xCell.Value
If TypeName(xVal) = "String" And xVal <> "" Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
Next
End Sub
أفضل أدوات إنتاجية المكتب
عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت. انقر هنا للحصول على الميزة التي تحتاجها أكثر...
يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير
- تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
- فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
- يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!