新手求助：VBA代码无法将同文件夹文件首行合并至目标文件

原代码无法粘贴内容的核心原因 #

1. 目标工作表引用不稳定：使用ActiveSheet依赖当前焦点，运行过程中工作表切换会导致粘贴到错误位置
2. 空表的行号计算错误：目标表为空时，End(xlUp)会定位到A1，导致首行粘贴到第二行，甚至看起来没有粘贴
3. 复制粘贴的可靠性问题：依赖剪贴板的操作容易受系统或其他程序干扰

修正后的代码 #

Sub CopyTopRowFromFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim sourceWorkbook As Workbook
    Dim destWorksheet As Worksheet
    Dim lastRow As Long
    
    ' 设置文件夹路径（末尾必须带反斜杠）
    folderPath = "C:\Your\Folder\Path\"
    
    ' 直接指定目标工作表，替换成你的汇总表名称
    Set destWorksheet = ThisWorkbook.Sheets("汇总表")
    
    ' 遍历文件夹内所有CSV文件
    fileName = Dir(folderPath & "*.csv")
    Do While fileName <> ""
        ' 禁用警告并以只读方式打开源文件，避免锁定和弹窗
        Application.DisplayAlerts = False
        Set sourceWorkbook = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        Application.DisplayAlerts = True
        
        ' 计算目标表最后一行，处理空表情况
        lastRow = destWorksheet.Cells(destWorksheet.Rows.Count, 1).End(xlUp).Row
        If lastRow = 1 And destWorksheet.Cells(1, 1).Value = "" Then
            lastRow = 0 ' 空表时从第1行开始粘贴
        End If
        
        ' 直接赋值替代复制粘贴，更稳定（也可保留原复制粘贴逻辑）
        destWorksheet.Rows(lastRow + 1).Value = sourceWorkbook.Sheets(1).Rows(1).Value
        
        ' 关闭源文件不保存
        sourceWorkbook.Close SaveChanges:=False
        
        ' 获取下一个文件
        fileName = Dir
    Loop
    
    Application.CutCopyMode = False
    MsgBox "所有文件首行已复制完成", vbInformation
End Sub

关键修改说明 #

• 固定目标工作表：放弃ActiveSheet，直接通过工作表名称引用，彻底避免焦点切换导致的错误
• 空表处理逻辑：增加判断确保空表时首行内容粘贴到A1，不会跳过第一行
• 更稳定的赋值方式：用Value直接赋值替代复制粘贴，无需依赖剪贴板，避免各种意外干扰
• 优化文件打开：只读打开+禁用警告，防止文件锁定和CSV格式提示弹窗打断程序

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