循环代码保留从文件夹中的相同Excel电子表格复制
题
所以我试图在文件夹(文件名和路径)中创建一个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.work表格(“Leavereport”)。范围(“C”&CopyPathrow)
,并“支持”通过以下方式更新for循环:
copypathrow= copypathrow + 1
解决方案
移动行
CopyPath = ThisWorkbook.Worksheets("LeaveReport").Range("C" & CopyPathRow)
在循环中,CopyPath
的值永远不会被更改,但CopyPathRow
的值是。
编辑:也不会调用此递归。
不隶属于 StackOverflow