Код цикла продолжает копирование из одной и той же электронной таблицы Excel в папку

StackOverflow https://stackoverflow.com//questions/25079506

  •  02-01-2020
  •  | 
  •  

Вопрос

Итак, я пытался создать список файлов 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.Рабочие листы("LeaveReport").Диапазон("C" & CopyPathRow)

и "предполагается" обновлять в цикле For с помощью этого:

Копировальный путь = копировальный путь + 1

Это было полезно?

Решение

Переместите линию

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

Внутри цикла это значение CopyPath никогда не меняется, но значение CopyPathRow является.

Редактировать:Я бы тоже не назвал это рекурсией.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top