كيف يمكن نسخ أو نقل الملفات من مجلد إلى آخر استنادًا إلى قائمة موجودة في Excel؟
إذا كانت لديك قائمة بأسماء الملفات في عمود داخل ورقة عمل، وكانت هذه الملفات موجودة فعليًّا في مجلد على جهازك، وتحتاج الآن إلى نقلها أو نسخها من موقعها الأصلي إلى مجلد آخر—كما يظهر في لقطة الشاشة التالية—فكيف يمكنك إنجاز هذه المهمة بأسرع وقت ممكن في Excel؟
نسخ أو نقل الملفات من مجلد إلى آخر بناءً على قائمة في Excel باستخدام كود VBA
نسخ أو نقل الملفات من مجلد إلى آخر بناءً على قائمة في Excel باستخدام كود VBA
لنقل الملفات من مجلد إلى آخر وفقًا لقائمة بأسماء الملفات، يمكنك استخدام كود VBA التالي. يُرجى اتباع الخطوات التالية:
1. اضغط مع الاستمرار على مفاتيحAlt + F11 في Excel، وستفتح نافذةMicrosoft Visual Basic for Applications.
2. انقر فوقInsert > Module، ثم الصق كود VBA التالي في نافذة الوحدة (Module Window).
كود VBA: نقل الملفات من مجلد إلى آخر بناءً على قائمة في Excel
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 أدناه:
كود 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
افتح سحر إكسل مع KUTOOLS AI
- التنفيذ الذكي: نفِّذ عمليات الخلايا، وحلِّل البيانات، وأنشئ المخططات البيانية — كل ذلك بأوامر بسيطة!
- الصيغ المخصصة: أنشئ صيغًا مخصصة لتبسيط سير عملك.
- برمجة VBA: اكتب وأَنفِذ أكواد VBA بسلاسة تامة.
- تفسير الصيغ: افهم الصيغ المعقدة بسهولة!
- ترجمة النصوص: اكسر الحواجز اللغوية في جداولك الإلكترونية!
أفضل أدوات الإنتاجية لمكتبتك
عزِّز مهاراتك في Excel باستخدام Kutools لـ Excel، وعايش الكفاءة كما لم تفعل من قبل.يقدّم Kutools لـ Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية ووقت الحفظ.انقر هنا للحصول على الميزة التي تحتاجها أكثر من غيرها...
يجلب Office Tab واجهة ذات علامات تبويب إلى Office، ويجعل عملك أسهل بكثير
- تمكّن من التحرير والقراءة باستخدام علامات التبويب في Word وExcel وPowerPoint، وPublisher وAccess وVisio وProject.
- افتح وأنشئ مستندات متعددة في علامات تبويب جديدة داخل النافذة نفسها، بدلاً من فتح نوافذ جديدة.
- يزيد إنتاجيتك بنسبة 50% ويوفّر لك مئات نقرات الفأرة كل يوم!
جميع الإضافات من Kutools في برنامج تثبيت واحد!
Kutools for Office حزمةٌ تحتوي على إضافاتٍ مخصصة لتطبيقات Excel وWord وOutlook وPowerPoint، إلى جانب Office Tab Pro، مما يجعلها الخيار المثالي للفِرق التي تعمل عبر تطبيقات Office.
- حزمة شاملة واحدة— إضافات Excel وWord وOutlook وPowerPoint بالإضافة إلى Office Tab Pro
- برنامج تثبيت واحد، ترخيص واحد— الإعداد خلال دقائق (جاهز لـ MSI)
- يعمل بشكل أفضل معًا— إنتاجية ميسَّرة عبر تطبيقات Office
- تجربة مجانية لمدة 30 يومًا بكامل الميزات— بدون تسجيل، بدون بطاقة ائتمان
- أفضل قيمة— وفِّر مقارنةً بشراء الإضافات بشكل منفصل