كيفية إجراء حلقة عبر الملفات في دليل ونسخ البيانات إلى ورقة رئيسية في Excel؟
لنفترض أن هناك العديد من مصنفات Excel في مجلد ، وتريد تكرار كل ملفات Excel هذه ونسخ البيانات من نطاق محدد من أوراق العمل ذات الاسم نفسه إلى ورقة عمل رئيسية في Excel ، فماذا يمكنك أن تفعل؟ تقدم هذه المقالة طريقة لتحقيق ذلك بالتفصيل.
قم بالتكرار خلال الملفات الموجودة في دليل وانسخ البيانات إلى ورقة رئيسية برمز VBA
قم بالتكرار خلال الملفات الموجودة في دليل وانسخ البيانات إلى ورقة رئيسية برمز VBA
إذا كنت ترغب في نسخ البيانات المحددة في النطاق A1: D4 من كافة أوراق المصنفات الموجودة في مجلد معين إلى ورقة رئيسية ، فيرجى القيام بما يلي.
1. في المصنف الذي ستقوم بإنشاء ورقة عمل رئيسية ، اضغط على قديم + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.
2. في ال ميكروسوفت فيسوال باسيك للتطبيقات الإطار، انقر فوق إدراج > وحدة. ثم انسخ رمز VBA أدناه في نافذة الكود.
كود فبا: تكرار الملفات في مجلد وانسخ البيانات إلى ورقة رئيسية
Sub Merge2MultiSheets()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook As Workbook
Dim xSheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "A1:D4"
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDlg
If .Show = -1 Then
xSelItem = .SelectedItems.Item(1)
Set xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("New Sheet")
If xSheet Is Nothing Then
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
Set xSheet = xWorkBook.Sheets("New Sheet")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
If xFileName = "" Then Exit Sub
Do Until xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xFileName = Dir()
xBook.Close
Loop
End If
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
ملاحظات:
3. اضغط على F5 مفتاح لتشغيل الكود.
4. في الافتتاح تصفح نافذة ، يرجى تحديد المجلد الذي يحتوي على الملفات التي ستمررها ، ثم انقر فوق OK زر. انظر لقطة الشاشة:
ثم يتم إنشاء ورقة عمل رئيسية تسمى "ورقة جديدة" في نهاية المصنف الحالي. ويتم سرد البيانات الموجودة في النطاق A1: D4 لكل Sheet1 في المجلد المحدد داخل ورقة العمل.
مقالات ذات صلة:
أفضل أدوات إنتاجية المكتب
عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت. انقر هنا للحصول على الميزة التي تحتاجها أكثر...
يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير
- تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
- فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
- يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!