Excel VBA跨文件数据导入问题：表名异常与数据定位错误

我帮你拆解代码里的问题，逐个给出修复方案：

问题1：循环中工作表名称变为人员姓名 #

你代码里的wks1.Name = "Overview"完全是多余的操作，而且放在循环里会引发异常——wks1已经通过Set wks1 = wkb1.Worksheets("Overview")绑定到目标工作表了，这行代码本质是试图重复给工作表重命名，一旦变量出现意外覆盖（比如和Name变量混淆），就会把工作表名改成人员姓名。直接删掉这行代码就能解决这个问题。

问题2：数据无法导入到正确位置 #

这个问题有几个核心诱因，我给你逐一修正：

• ActiveCell作为Find的起始点不稳定：ActiveCell的位置是随机的，可能导致查找从错误区域开始，改成从工作表第一个单元格wks1.Cells(1,1)开始查找更可靠。
• LookAt:=xlPart容易误匹配：如果表格里有备注、其他字段包含人员姓名的片段，会导致匹配错误，改成LookAt:=xlWhole只匹配完全一致的单元格。
• 缺少查找失败的容错处理：如果File2里的姓名在File1中找不到，代码会直接报错中断，需要增加判断避免这种情况。
• 月份查找的参数不严谨：查找月份列时同样要确保完全匹配，避免找到包含月份关键词的其他内容。

修改后的完整代码 #

Private Sub CommandButton1_Click()
    Dim wkb As Workbook
    Dim wkb1 As Workbook
    Dim wks As Worksheet
    Dim wks1 As Worksheet
    Dim zeileErsterName As Long
    Dim spalteName As Long
    Dim Monat As String
    Dim MonatBudgetCell As Range
    Dim MonatBelegCell As Range
    Dim Name As String
    Dim zeileName As Range
    Dim zeileStaffingtage As Long
    
    zeileErsterName = 8
    spalteName = 2
    
    ' 建议使用完整文件路径，避免ChDir带来的路径不确定性
    Set wkb = Workbooks.Open(Filename:="你的File2完整路径\File2.xlsm")
    Set wkb1 = ThisWorkbook ' 若代码存放在File1中，用ThisWorkbook更可靠
    Set wks = wkb.Worksheets("Jan-Dez")
    Set wks1 = wkb1.Worksheets("Overview")
    
    Monat = ListBox1.Value
    ' 查找File1中的目标月份列，确保完全匹配
    Set MonatBudgetCell = wks1.Cells.Find(What:=Monat, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If MonatBudgetCell Is Nothing Then
        MsgBox "在File1中找不到指定月份：" & Monat, vbExclamation
        wkb.Close SaveChanges:=False
        Exit Sub
    End If
    MonatBudget = MonatBudgetCell.Column
    
    Monat = Left(Monat, 3)
    ' 查找File2中的目标月份列，确保完全匹配
    Set MonatBelegCell = wks.Cells.Find(What:=Monat, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If MonatBelegCell Is Nothing Then
        MsgBox "在File2中找不到月份缩写：" & Monat, vbExclamation
        wkb.Close SaveChanges:=False
        Exit Sub
    End If
    MonatBeleg = MonatBelegCell.Column
    
    ' 循环读取File2的人员数据
    While Not IsEmpty(wks.Cells(zeileErsterName, spalteName))
        Name = wks.Cells(zeileErsterName, spalteName).Value
        ' 查找File1中的对应人员，从A1开始、完全匹配
        Set zeileName = wks1.Cells.Find(What:=Name, After:=wks1.Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not zeileName Is Nothing Then
            zeileStaffingtage = zeileName.Row + 1
            wks1.Cells(zeileStaffingtage, MonatBudget).Value = wks.Cells(zeileErsterName, MonatBeleg).Value
            Debug.Print "已导入：" & Name & " 的数据到行 " & zeileStaffingtage
        Else
            Debug.Print "未找到匹配人员：" & Name
        End If
        
        ' 此处+2需确保File2的人员姓名确实是隔2行出现，可根据实际结构调整
        zeileErsterName = zeileErsterName + 2
    Wend
    
    wkb.Close SaveChanges:=False
    MsgBox "数据导入完成！", vbInformation
End Sub

额外优化建议 #

• 用ThisWorkbook替代Workbooks("File1.xlsm")：如果代码存储在File1中，这样能避免文件名变更导致的绑定错误。
• 固定文件路径：Workbooks.Open时使用完整路径（比如C:\Project\File2.xlsm），不要依赖ChDir，路径稳定性更高。
• 增加提示弹窗：找不到月份或人员时弹出提示，方便快速排查问题。

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