Boucle de code conserve la copie à partir de la même feuille de calcul excel dans un dossier

Question

J'essayais donc de créer une liste de fichiers excel dans un dossier (chemin et nom de fichier), puis utiliser une boucle for Pour copier et coller une feuille de calcul spécifiée pour tous les fichiers répertoriés dans une feuille de calcul spécifiée dans le classeur excel qui contient la macro.Jusqu'à présent, tout fonctionne, sauf pour le fait que le même fichier ne cesse de le copier et le coller sur la place de tous les fichiers.La macro boucles pour le bon nombre de fois, mais il ne l'utilise pas tous les fichiers excel.

Voici le code:

Première partie pour lister les fichiers dans le dossier

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

et c'est la partie de la boucle

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

Basé sur la source de l'erreur, c'est à diremême fichier utilisé, je suppose que le problème réside dans la partie qui a ceci:

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

et il est "censé" mettre à jour dans la boucle For via ce:

CopyPathRow = CopyPathRow + 1

Answer 1

Déplacer la ligne

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

L'intérieur de la boucle, la valeur de CopyPath est de ne jamais être changé, mais la valeur de CopyPathRow est.

Edit:Je ne dirais pas qu'elle se soit.