Excel VBA宏修改需求：将CSV数据导入指定Consol.xlsx而非工具文件

我看了你的代码，核心问题是过度依赖ActiveWorkbook和ActiveSheet——当你新建Consol.xlsx后，后续的导入操作可能因为焦点切换（比如工具文件重新获得激活），导致数据被导入到工具自身，而不是目标文件。下面是修正后的完整代码，以及关键修改点的说明：

修正后的完整VBA代码 #

Sub Button_click2()
    Dim consolWb As Workbook
    ' 创建Consol.xlsx并获取它的工作簿对象
    Set consolWb = AddNew()
    ' 把目标工作簿传入导入函数，明确操作对象
    Call ImportCSV(consolWb)
End Sub

Function AddNew() As Workbook
    Application.DisplayAlerts = False
    Dim toolWb As Workbook
    Set toolWb = ActiveWorkbook ' 记录你的工具原文件
    Dim newConsolWb As Workbook
    ' 新建工作簿并保存为Consol.xlsx
    Set newConsolWb = Workbooks.Add
    newConsolWb.SaveAs Filename:=toolWb.Path & "\Consol.xlsx"
    Application.DisplayAlerts = True
    ' 返回新建的目标工作簿，供后续导入使用
    Set AddNew = newConsolWb
End Function

Sub ImportCSV(targetWb As Workbook)
    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
    ' 源CSV文件的路径和工具文件一致（即Consol.xlsx所在路径）
    strSourcePath = targetWb.Path
    If Right(strSourcePath, 1) <> "\" Then
        strSourcePath = strSourcePath & "\"
    End If
    
    ' 移动CSV的目标路径（和源路径相同，若不需要移动可注释）
    strDestPath = strSourcePath
    
    strFile = Dir(strSourcePath & "*.csv")
    Do While Len(strFile) > 0
        Cnt = Cnt + 1
        ' 锁定目标工作簿的第一个工作表，避免操作错误的表
        With targetWb.Sheets(1)
            r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            Open strSourcePath & strFile For Input As #1
            Do Until EOF(1)
                Line Input #1, strData
                x = Split(strData, ",")
                For c = 0 To UBound(x)
                    .Cells(r, c + 1).Value = Trim(x(c))
                Next c
                r = r + 1
            Loop
            Close #1
        End With
        
        ' 移动处理完的CSV文件（不需要的话可以删掉这行）
        Name strSourcePath & strFile As strDestPath & strFile
        strFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    If Cnt = 0 Then
        MsgBox "No CSV files were found...", vbExclamation
    End If
End Sub

关键修改点说明 #

• 用明确的工作簿对象替代ActiveWorkbook：
  • 把AddNew从Sub改成Function，返回新建的Consol.xlsx工作簿对象，这样后续导入操作可以直接绑定这个对象，彻底避免“激活状态切换”导致的错误。
  • ImportCSV新增参数targetWb As Workbook，直接接收目标工作簿，所有单元格操作都明确指向这个工作簿的工作表，不再依赖模糊的ActiveSheet。
• 修正路径逻辑：原代码里strSourcePath依赖ActiveWorkbook.Path，如果此时工具文件重新激活，路径就会指向工具文件所在位置。现在直接用targetWb.Path（也就是Consol.xlsx的路径，和工具文件同目录），确保能正确找到CSV文件。
• 使用With语句锁定目标工作表：所有导入操作都在targetWb.Sheets(1)的范围内执行，就算中途切换了工作表，也不会影响导入位置。
• 修正按钮事件的调用：原代码里调用了不存在的ImportCSVsWithReference，现在改成正确的ImportCSV并传入目标工作簿。

额外小提示 #

• 如果你的CSV文件都有表头，不想重复导入表头，可以在Do Until EOF(1)循环前加判断：比如第一次导入时保留表头，后续的CSV跳过第一行。
• 代码里的Name ... As ...是把处理完的CSV文件移动到目标路径（这里和源路径一致，相当于原地重命名？如果不需要移动文件，直接注释掉这行即可）。

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