VBA遍历文件夹工作簿汇总到总表时FName变量为空、Dir函数异常问题

你对Dir函数的用法完全错了，这是FName为空的根本原因：

• Dir(参数) 带参数调用时返回的是匹配到的第一个文件/文件夹名称，不是你以为的路径。你原来的代码里把文件夹路径直接赋值给Dir()的返回值，导致FilePath变量从一开始就存的不是目标文件夹路径，而是目标文件夹下第一个子项的名称（如果没有就直接是空）
• 后续你又拼接FilePath & ".xlsx"作为Dir的参数，路径完全不合法，自然返回空字符串。

• 变量名拼写错误：你定义的工作表变量是MasterSheet，后续粘贴数据时错写为Masterlist，运行会报变量未定义错误
• 单元格区域归属错误：你要读取的是CurrentSheet里的内容，代码里错误用CurrentBook.Range调用，会出现范围匹配错误
• 数据写入逻辑错误：每次写入都从Master_List表的第10行开始写，会覆盖之前已经写入的内容，不会逐次追加
• 路径补反斜杠的逻辑写在Dir调用之后，完全没起到作用

Sub StuffYourLendersInMyMouth()

Dim MasterBook As Workbook
Dim CurrentBook As Workbook
Dim MasterSheet As Worksheet
Dim CurrentSheet As Worksheet
Dim FilePath As String ' 路径用字符串类型即可
Dim FName As String

Dim MasterLR As Long ' 行数用Long类型，不要用Double
Dim CurrentLR As Long
Dim WriteStartRow As Long ' 追加写入的起始行

Dim LenderCol As Integer
Dim LoanCol As Integer
Dim DateCol As Integer
Dim PropCol As Integer
Dim AddCol As Integer

Dim CopyRng1 As Variant
Dim CopyRng2 As Variant
Dim CopyRng3 As Variant
Dim CopyRng4 As Variant
Dim CopyRng5 As Variant

'Set Objects
Set MasterBook = Workbooks("Bend_Lender_List.xlsm")
Set MasterSheet = MasterBook.Worksheets("Master_List")

'Define Variables
' 先存文件夹路径，不要一开始就套Dir
FilePath = "C:\Users\James\OneDrive\Desktop\Title_Lenders\"
' 先补路径末尾的反斜杠
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
' 第一次调用Dir获取第一个xlsx文件的名称
FName = Dir(FilePath & "*.xlsx") ' 加通配符*匹配所有xlsx后缀的文件

MasterLR = 2
CurrentLR = 10

LenderCol = 1
LoanCol = 2
DateCol = 5
PropCol = 10
AddCol = 11

Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False

While FName <> ""
    ' 计算当前Master表要写入的起始行（现有数据最后一行+1）
    WriteStartRow = MasterSheet.Cells(MasterSheet.Rows.Count, 1).End(xlUp).Row + 1
    
    Set CurrentBook = Workbooks.Open(Filename:=FilePath & FName)
    Set CurrentSheet = CurrentBook.Sheets(1)
    CurrentLR = CurrentSheet.Cells(CurrentSheet.Rows.Count, 1).End(xlUp).Row
    
    ' 读取当前表的内容
    CopyRng1 = CurrentSheet.Range(CurrentSheet.Cells(10, LenderCol), CurrentSheet.Cells(CurrentLR, LenderCol))
    CopyRng2 = CurrentSheet.Range(CurrentSheet.Cells(10, LoanCol), CurrentSheet.Cells(CurrentLR, LoanCol))
    CopyRng3 = CurrentSheet.Range(CurrentSheet.Cells(10, DateCol), CurrentSheet.Cells(CurrentLR, DateCol))
    CopyRng4 = CurrentSheet.Range(CurrentSheet.Cells(10, PropCol), CurrentSheet.Cells(CurrentLR, PropCol))
    CopyRng5 = CurrentSheet.Range(CurrentSheet.Cells(10, AddCol), CurrentSheet.Cells(CurrentLR, AddCol))
    
    ' 写入到Master表，从计算好的起始行开始写
    MasterSheet.Range(MasterSheet.Cells(WriteStartRow, 1), MasterSheet.Cells(WriteStartRow + UBound(CopyRng1, 1) - 1, 1)) = CopyRng1
    MasterSheet.Range(MasterSheet.Cells(WriteStartRow, 2), MasterSheet.Cells(WriteStartRow + UBound(CopyRng2, 1) - 1, 2)) = CopyRng2
    MasterSheet.Range(MasterSheet.Cells(WriteStartRow, 3), MasterSheet.Cells(WriteStartRow + UBound(CopyRng3, 1) - 1, 3)) = CopyRng3
    MasterSheet.Range(MasterSheet.Cells(WriteStartRow, 4), MasterSheet.Cells(WriteStartRow + UBound(CopyRng4, 1) - 1, 4)) = CopyRng4
    MasterSheet.Range(MasterSheet.Cells(WriteStartRow, 5), MasterSheet.Cells(WriteStartRow + UBound(CopyRng5, 1) - 1, 5)) = CopyRng5

    ' 获取下一个文件名称
    FName = Dir
    CurrentBook.Close SaveChanges:=False ' 读取不需要保存源文件
Wend

' 恢复设置
Application.ScreenUpdating = True
MsgBox "数据汇总完成"

End Sub

• 如果目标文件夹下还有xls格式的文件，把Dir的参数改成*.xls*即可匹配所有Excel文件
• 运行代码前请确认Bend_Lender_List.xlsm已经处于打开状态，否则会报下标越界错误
• 如果要保留原表第10行之前的表头数据，代码的写入逻辑已经做了兼容，不会覆盖表头

内容的提问来源于stack exchange，提问作者jacka