Loop Code continua a copiare dallo stesso foglio di calcolo di Excel in una cartella
Domanda
Quindi stavo cercando di creare un elenco di file Excel in una cartella (nome file e percorso) e quindi utilizzare A per loop per copiare e incollare un foglio di lavoro specificato per tutti i file elencati in un foglio di lavoro specificato nella cartella di lavoro Excelche contiene la macro.Finora tutto funziona tranne che per il fatto che lo stesso file continua a essere copiato e incollato invece di tutti i file.Il macro loop per il numero corretto di volte, ma non sta utilizzando tutti i file Excel.
Ecco il codice:
Prima parte per la lista dei file nella cartella
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
.
E questa è la parte per il loop
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
.
In base alla fonte dell'errore, I.e. Lo stesso file utilizzato, immagino che il problema si trova con la parte che ha questo:
Copypath= Thisworkbook.Worksheet ("Leavereport"). Intervallo ("C" e Copypathrow)
ed è "supposto" da aggiornare nel ciclo per questo:
Copypathrow= Copypathrow + 1
Soluzione
Sposta la linea
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
All'interno del ciclo, quel valore del CopyPath
non viene mai modificato, ma il valore del CopyPathRow
è.
Modifica: non chiamerei questa ricorsione.