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
La solution
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.