第一个文件closures后，所有的行一行
我有一个代码，它列出了第1列和第4列中的一个名称的单元格，以及第2列和第3列中与这些名称相对应的信息，它们占用了很多行。
第一个文件运行良好，但后面的所有文件都打印比应该低一行。 我一直在玩它，我想这是一个简单的修复+1的地方不应该或需要拿走以下文件的+1 ..但我找不到它。 这是一个正在发生的事情的形象。 我的代码在下面提供。 第（5）部分是我打印第1和第4列中的信息的地方。有什么想法？
完整代码：
Option Explicit Sub LoopThroughDirectory() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim MyFolder As String Dim StartSht As Worksheet, ws As Worksheet Dim WB As Workbook Dim i As Integer Dim LastRow As Integer, erow As Integer Dim Height As Integer Dim RowLast As Long 'turn screen updating off - makes program faster 'Application.ScreenUpdating = False 'location of the folder in which the desired TDS files are MyFolder = "C:\Users\trembos\Documents\TDS\progress\" 'Set StartSht = ActiveSheet Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1") 'create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'get the folder object Set objFolder = objFSO.GetFolder(MyFolder) i = 1 'loop through directory file and print names '(1) For Each objFile In objFolder.Files If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then '(2) 'print file name to Column 1 Set WB = Workbooks.Open(fileName:=MyFolder & objFile.Name) Set ws = WB.ActiveSheet '(3) 'copy HOLDER column from F11 (11, 6) until empty With ws LastRow = GetLastRowInColumn(ws, "A") .Range(.Cells(11, 6), .Cells(LastRow, 6)).Copy End With Dim destination LastRow = GetLastRowInColumn(StartSht, "B") Set destination = StartSht.Range("B" & LastRow).Offset(1) 'print HOLDER column to column 2 in masterfile in next available row destination.PasteSpecial '(4) 'ReDefine the destination range to paste into Column C LastRow = GetLastRowInColumn(StartSht, "C") Set destination = StartSht.Range("C" & LastRow).Offset(1) With ws 'copy CUTTING TOOL column from F11 (11, 7) until empty LastRow = GetLastRowInColumn(ws, "G") 'print CUTTING TOOL column to column 3 in masterfile in next available row .Range(.Cells(11, 7), .Cells(LastRow, 7)).Copy _ destination:=destination End With '(5) With WB 'print TDS information For Each ws In .Worksheets 'print the file name to Column 1 StartSht.Cells(i + 1, 1) = objFile.Name 'print TDS name to Column 4 With ws .Range("J1").Copy StartSht.Cells(i + 1, 4) End With i = GetLastRowInSheet(StartSht) + 1 'move to next file Next ws '(6) 'close, do not save any changes to the opened files .Close SaveChanges:=False End With End If 'move to next file Next objFile 'turn screen updating back on 'Application.ScreenUpdating = True ActiveWindow.ScrollRow = 1 '(7) End Sub Function GetLastRowInColumn(theWorksheet As Worksheet, col As String) With theWorksheet GetLastRowInColumn = .Range(col & .Rows.count).End(xlUp).Row End With End Function Function GetLastRowInSheet(theWorksheet As Worksheet) Dim ret With theWorksheet If Application.WorksheetFunction.CountA(.Cells) <> 0 Then ret = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else ret = 1 End If End With GetLastRowInSheet = ret End Function 你正在使用variablesi来跟踪你应该在A列和D列中填写哪一行。你初始化i = 1 ，然后每次写入表格时加1 .Cells(i + 1,... 1当你更新variablesi = GetLastRowInSheet(StartSht) + 1
我build议你初始化i = 2 ，然后写入i行
'(5) With WB 'print TDS information For Each ws In .Worksheets 'print the file name to Column 1 StartSht.Cells(i, 1) = objFile.Name 'print TDS name to Column 4 With ws .Range("J1").Copy StartSht.Cells(i, 4) End With i = GetLastRowInSheet(StartSht) + 1 ' this gets the row number for the next file 'move to next file Next ws