首先将文件关闭一行后的所有行

Question

我有一个代码，用于在第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

Answer 1

您正在使用变量i来跟踪应填写A和D列的哪一行。您初始化i = 1，然后在每次写入工作表.Cells(i + 1,...时添加1。但是，当您更新变量i = GetLastRowInSheet(StartSht) + 1

时，也会添加1

我建议您初始化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