Excel VBA需求：批量复制数据时同步写入源文件名至目标表A列

问题说明 #

需要批量读取指定文件夹内的CSV文件，将每个文件中「ADJUSTMENTS_EXTR」工作表的A10至V列到「Total」行的数据，复制到主工作簿「Consolidated Data」工作表的B列，同时将对应源文件的名称写入该工作表的A列（每一行数据对应同一个文件名），原添加写入文件名的代码无法正常运行。

原代码问题分析 #

• 在With wkbSource代码块中使用.wkbDest是错误的，wkbDest是独立的工作簿对象，不属于wkbSource的成员
• 尝试的代码仅写入单个单元格，无法覆盖复制过来的所有数据行
• 未限定Rows.Count所属的工作表，可能导致引用错误

修正后的完整代码 #

Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRowSource As Long
    Dim StartRowDest As Long
    Dim CopyRowCount As Long
    Const strPath As String = "folder of data files" '替换为实际文件夹路径
    ChDir strPath
    strExtension = Dir("*.csv*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource.Sheets("ADJUSTMENTS_EXTR")
            '找到源数据的最后一行（Total行）
            LastRowSource = .Cells.Find("Total", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            '计算要复制的行数
            CopyRowCount = LastRowSource - 9 '因为从A10开始，行数为LastRowSource - 10 +1 = LastRowSource -9
            '找到目标工作表B列的最后一行，确定粘贴起始位置
            StartRowDest = wkbDest.Sheets("Consolidated Data").Cells(wkbDest.Sheets("Consolidated Data").Rows.Count, "B").End(xlUp).Row
            '如果是第一次粘贴，StartRowDest是表头行，需要偏移1行
            If StartRowDest = 1 Then StartRowDest = 2
            '复制源数据到目标表B列开始的区域
            .Range("A10:V" & LastRowSource).Copy wkbDest.Sheets("Consolidated Data").Cells(StartRowDest, "B")
            '批量写入源文件名到A列对应行
            wkbDest.Sheets("Consolidated Data").Range("A" & StartRowDest & ":A" & StartRowDest + CopyRowCount - 1).Value = wkbSource.Name
        End With
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True

关键修改点 #

• 调整With块的作用对象为源工作表wkbSource.Sheets("ADJUSTMENTS_EXTR")，减少对象引用混乱
• 计算复制数据的行数CopyRowCount，确定需要填充文件名的A列范围
• 明确指定Rows.Count所属的工作表，避免跨工作表引用错误
• 处理首次粘贴时的起始行问题，确保文件名从数据行开始填充
• 批量写入文件名，比逐行写入更高效

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