يستمر رمز الحلقة في النسخ من نفس جدول بيانات Excel في مجلد

Question

لذلك كنت أحاول إنشاء قائمة بملفات Excel في مجلد (اسم الملف والمسار) ثم استخدام حلقة For لنسخ ولصق ورقة عمل محددة لجميع الملفات المدرجة في ورقة عمل محددة في مصنف Excel الذي يحتوي على دقيق.حتى الآن كل شيء يعمل باستثناء حقيقة أن نفس الملف يتم نسخه ولصقه بدلاً من جميع الملفات.يكرر الماكرو العدد الصحيح من المرات، ولكنه لا يستخدم جميع ملفات Excel.

إليك الكود:

الجزء الأول لسرد الملفات الموجودة في المجلد

Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:\Administration\Time Sheets")
i = 2
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 2) = objFile.Name
    'print file path
    Cells(i + 1, 3) = objFile.Path
    i = i + 1
Next objFile
End Sub

وهذا هو الجزء الخاص بالحلقة

Private Sub btn_PullData()
'Declared Variables
Dim wbk As Workbook
Dim i As Integer
Dim StartAt As Integer
Dim EndAt As Integer
Dim CopyPath As String
Dim CopyPathRow As Integer
Dim iRow As Integer

'Ranges
StartAt = 1
EndAt = Val(ThisWorkbook.Worksheets("LeaveReport").Range("A1"))
CopyPathRow = 3
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
iRow = 3

'Loop de loop
For i = StartAt To EndAt
    Application.ScreenUpdating = False
    Set wbk = Workbooks.Open(CopyPath)
    Sheets("TIMESHEET").Select
    Range("C12:S34").Select
    Selection.Copy

    ThisWorkbook.Activate
    Sheets("Pastebin").Select
    Range("a" & iRow).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    iRow = iRow + 39
    CopyPathRow = CopyPathRow + 1
    wbk.Close True
Next i

Sheets("Pastebin").Select
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Timesheet Data Imported"
End Sub

بناء على مصدر الخطأ، أي.نفس الملف المستخدم، أعتقد أن المشكلة تكمن في الجزء الذي يحتوي على هذا:

CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)

ومن "المفترض" التحديث في حلقة For عبر هذا:

CopyPathRow = CopyPathRow + 1

Answer 1

حرك الخط

CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)

داخل الحلقة، قيمة CopyPath لا يتم تغييره أبدًا، ولكن قيمة CopyPathRow يكون.

يحرر:لن أسمي هذا العودية أيضًا.