VBA宏执行报错Run-time error '1004'：复制至变量工作表问题求助

问题 #

需要实现将固定区域（C4:C178）复制粘贴至下拉框选择的目标工作表及指定列中，已设置两个下拉框分别选择工作表名称（存于I3单元格）和列号（存于I4单元格），点击宏按钮执行操作。现有VBA代码运行时触发Run-time error '1004': Application-define or object-defined error，报错行指向ws.Cells相关代码：

Sub CopyPaste()
    Dim Sheetname As String
    Sheetname = ActiveSheet.Range("i3").Value
    Dim Col As Long
    Col = ActiveSheet.Range("i4").Value
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Tracking Only")
    Dim rng As Range
    Set rng = ActiveSheet.Range("c4:C178")
    With rng
        ws.Cells(4, Col).Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With
End Sub

问题排查与修复方案 #

核心错误原因 #

代码硬编码了目标工作表为"Tracking Only"，完全忽略了下拉框选择的Sheetname变量，这是逻辑偏离需求的核心问题；同时缺少对输入参数合法性的校验，进一步放大了报错概率。

修正后的代码 #

Sub CopyPaste()
    Dim targetSheetName As String
    Dim targetCol As Long
    Dim targetWs As Worksheet
    Dim sourceRng As Range
    
    ' 获取下拉框选择的参数
    targetSheetName = ActiveSheet.Range("I3").Value
    targetCol = ActiveSheet.Range("I4").Value
    
    ' 校验选择的工作表是否存在
    On Error Resume Next
    Set targetWs = ThisWorkbook.Worksheets(targetSheetName)
    On Error GoTo 0
    If targetWs Is Nothing Then
        MsgBox "选择的工作表不存在，请重新选择"
        Exit Sub
    End If
    
    ' 校验列号是否在Excel合法范围内（1-16384）
    If targetCol < 1 Or targetCol > 16384 Then
        MsgBox "列号非法，请输入1-16384之间的数字"
        Exit Sub
    End If
    
    ' 设置源数据区域
    Set sourceRng = ActiveSheet.Range("C4:C178")
    
    ' 复制值到目标位置
    targetWs.Cells(4, targetCol).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count).Value = sourceRng.Value
End Sub

说明 #

• 修正了工作表选择逻辑，改用下拉框指定的targetSheetName作为目标工作表
• 新增工作表存在性校验，避免因选择无效表引发错误
• 新增列号合法性校验，防止输入超出Excel列范围的数值
• 优化变量命名，提升代码可读性

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