Excel VBA如果1行不自动填充几乎可以工作

Question

论坛新手，对VBA来说很新。我正在尝试整合每月数百种表格中的数据。我必须从表格（名称，日期，商店）中获取一些额外的字段，并与其他列一起填写。我遇到了只有一行数据并且无法自动填充的错误。我试图用IF来解决这个问题，然后，Else。发生的事情是在它击中具有该行的文件之后，它不会对具有多个行的任何后续文件执行自动填充。它几乎可以工作。

代码：

Sub test()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
Dim Erow
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

FolderPath = "C:\Users\Test\"
FileName = Dir(FolderPath & "*.xlsx")


    Do While FileName <> ""

    Workbooks.Open (FolderPath & FileName)
    Range("B10").Select
    Selection.Copy
    Range("K17").Select
    ActiveSheet.Paste
    Range("J9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L17").Select
    ActiveSheet.Paste
    Range("J11").Select
    Selection.Copy
    Range("M17").Select
    ActiveSheet.Paste

    Dim lastRow As Long
    If lastRow > 17 Then
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    Range("K17").AutoFill Destination:=Range("K17:K" & lastRow), 
    Type:=xlFillCopy
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    Range("L17").AutoFill Destination:=Range("L17:L" & lastRow), 
    Type:=xlFillCopy
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    Range("M17").AutoFill Destination:=Range("M17:M" & lastRow), 
    Type:=xlFillCopy
    Else
    ActiveWorkbook.Save
    Range("A17:M200").Copy
    ActiveWorkbook.Close
    End If

Erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(Erow, 1), Cells(Erow, 13))

FileName = Dir

Loop
End Sub

以下是“一行”文件后发生的事情的屏幕截图。

一行后出错，自动填充停止

Answer 1

问题产生于在IF声明中计算lastrow。只有当lastRow＆gt;时才会重新计算lastrow。上一本工作手册中的17。

在IF语句之前计算lastrow，以便每次都查看当前工作簿的lastrow。