VBA跨工作表复制数据时写入单元格触发Error 1004错误求助

常见原因排查 #

Error 1004通常和以下情况有关：

• 目标工作表处于保护状态，无法修改单元格
• 单元格引用未明确指定工作表，导致指向错误的单元格
• 循环逻辑错误，导致重复操作同一单元格引发异常
• 偏移后的单元格超出工作表范围（比如列数不足）

针对你的代码的修复方案 #

你的代码存在几个关键问题，以下是修改后的版本及说明：

Sub FillSheets()
    Dim MainSheet As Worksheet
    Dim DeviceSheet As Worksheet
    Dim MainSheetCell As Range
    Dim DeviceSheetCell As Range
    Dim AnlagenName As String
    
    ' 明确指定工作表对象，避免激活带来的问题
    Set MainSheet = Worksheets("MAA#Kennzeichnung")
    Set DeviceSheet = Worksheets("Device-Label")
    ' 初始化起始单元格
    Set MainSheetCell = MainSheet.Range("B5")
    ' 明确指定AnlagenName的来源工作表
    AnlagenName = "==" & MainSheet.Range("B2").Value
 
    ' 循环处理每行数据
    Do
        ' 遇到空单元格退出循环
        If MainSheetCell.Value = "" Then Exit Do
        
        ' 判断设备是否在目标区域
        If MainSheetCell.Offset(0, 1).Value = "+X" Then
            Dim Buffer1 As Variant
            Dim Buffer2 As Variant
            Dim Buffer3 As Variant
            Dim Buffer4 As Variant
            
            Buffer1 = MainSheetCell.Offset(0, -1).Value
            Buffer2 = MainSheetCell.Value
            Buffer3 = MainSheetCell.Offset(0, 2).Value
            Buffer4 = AnlagenName & "-" & MainSheetCell.Value
            Buffer1 = "Test"
            
            ' 找到DeviceSheet中第一个空行的A列单元格（避免一直写入A2）
            Set DeviceSheetCell = DeviceSheet.Cells(DeviceSheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
            ' 如果A2是空的，就从A2开始
            If DeviceSheetCell.Row > 2 Then Set DeviceSheetCell = DeviceSheet.Range("A2")
            
            ' 写入数据
            DeviceSheetCell.Value = Buffer1
            DeviceSheetCell.Offset(0, 1).Value = Buffer2
            DeviceSheetCell.Offset(0, 2).Value = Buffer3
            DeviceSheetCell.Offset(0, 3).Value = Buffer4
        End If
       
        ' 向下移动MainSheetCell，而不是用ActiveCell
        Set MainSheetCell = MainSheetCell.Offset(1, 0)
    Loop
End Sub

关键修改点说明 #

1. 明确指定工作表对象：

   • 直接定义MainSheet和DeviceSheet对象，所有Range操作都绑定到对应的工作表，避免因激活状态变化导致的引用错误。
   • AnlagenName的来源从Range("B2")改为MainSheet.Range("B2")，确保读取的是目标工作表的B2单元格。

2. 修复循环逻辑：

   • 原代码用ActiveCell.Offset(1,0).Activate来移动，但MainSheetCell始终指向B5，会导致无限循环处理同一单元格，可能引发异常。修改为直接更新MainSheetCell的引用：Set MainSheetCell = MainSheetCell.Offset(1, 0)。

3. 优化目标单元格写入位置：

   • 原代码每次都写入Device-Label的A2单元格，会覆盖之前的数据。修改为找到A列最后一个非空单元格的下一行，避免数据覆盖。

4. 额外排查项：

   • 确认Device-Label工作表没有被保护：右键工作表标签→取消保护工作表（如果有密码需要输入）。
   • 检查Buffer2的值是否包含特殊字符或过长内容（虽然你说读取正常，但极端情况下也可能导致写入失败）。

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