请求协助完善VBA代码：基于C6匹配第2行实现跨工作表数据迁移

之前我基于A列行名称匹配实现过跨工作表数据复制功能，现在需要实现：当"Form"工作表的C6单元格匹配目标工作表第2行（E2:P2区域）任意单元格时，将"Form"工作表指定单元格的数据复制到目标工作表对应列的指定行中。目前编写的VBA代码前半部分可正常运行，请求协助确认该方案是否可行，并完善代码。

图片说明：

• 图1 - 数据目标位置
• 图2 - 数据来源位置

Sub Copy_Data()
 Dim hh As Worksheet, exist As Boolean, h As Worksheet, sh As Worksheet
 Dim f As Range

 Set hh = Sheets("Form")
 If hh.Range("C5") = "" Then
 MsgBox "Please select the year", vbCritical
 Exit Sub
 End If
 If hh.Range("c6") = "" Then
 MsgBox "Please select the month", vbCritical
 Exit Sub
 End If
 exist = False
 For Each h In Sheets
 If LCase(h.Name) = LCase(hh.Range("c5").Value) Then
  Set sh = h
  exist = True
  Exit For
 End If
 Next
 If exist = False Then
 MsgBox "The sheet does not exist", vbCritical
 Exit Sub
 End If

 Set f = sh.Range("e2:p2").Find(hh.Range("C6").Value, , xlValues, xlWhole)
 If f Is Nothing Then
 MsgBox "The month cannot be found", vbCritical

  ---------Works up to this point --------

 Else
 'cell destination             cell origin
 sh.Cells(f.Column, "3").Value = hh.Range("C8").Value
 sh.Cells(f.Column, "5").Value = hh.Range("c10").Value
 sh.Cells(f.Column, "6").Value = hh.Range("C11").Value
 sh.Cells(f.Column, "8").Value = hh.Range("C14").Value
 sh.Cells(f.Column, "i").Value = hh.Range("C15").Value
 sh.Cells(f.Column, "j").Value = hh.Range("C16").Value
 sh.Cells(f.Column, "k").Value = hh.Range("C17").Value
 sh.Cells(f.Column, "l").Value = hh.Range("C18").Value
 sh.Cells(f.Column, "m").Value = hh.Range("C20").Value
 sh.Cells(f.Column, "o").Value = hh.Range("C21").Value
 sh.Cells(f.Column, "p").Value = hh.Range("C22").Value
 sh.Cells(f.Column, "q").Value = hh.Range("C23").Value
 sh.Cells(f.Column, "s").Value = hh.Range("C24").Value
 sh.Cells(f.Column, "v").Value = hh.Range("C27").Value
 sh.Cells(f.Column, "w").Value = hh.Range("C28").Value
 sh.Cells(f.Column, "x").Value = hh.Range("C29").Value
 sh.Cells(f.Column, "y").Value = hh.Range("C30").Value
 sh.Cells(f.Column, "z").Value = hh.Range("C31").Value
 sh.Cells(f.Column, "ab").Value = hh.Range("C34").Value
 sh.Cells(f.Column, "ac").Value = hh.Range("C35").Value
 sh.Cells(f.Column, "ad").Value = hh.Range("C36").Value
 sh.Cells(f.Column, "af").Value = hh.Range("C39").Value
 sh.Cells(f.Column, "ag").Value = hh.Range("C40").Value
 sh.Cells(f.Column, "ah").Value = hh.Range("C41").Value
 sh.Cells(f.Column, "aj").Value = hh.Range("C44").Value
 sh.Cells(f.Column, "ak").Value = hh.Range("C45").Value
 sh.Cells(f.Column, "al").Value = hh.Range("C46").Value
 sh.Cells(f.Column, "am").Value = hh.Range("C47").Value
 sh.Cells(f.Column, "ar").Value = hh.Range("C50").Value
 sh.Cells(f.Column, "as").Value = hh.Range("C51").Value
 sh.Cells(f.Column, "at").Value = hh.Range("C52").Value
 sh.Cells(f.Column, "aw").Value = hh.Range("C55").Value
 sh.Cells(f.Column, "ax").Value = hh.Range("C56").Value
 sh.Cells(f.Column, "az").Value = hh.Range("C59").Value
 sh.Cells(f.Column, "ba").Value = hh.Range("C60").Value
 sh.Cells(f.Column, "bb").Value = hh.Range("C61").Value
 sh.Cells(f.Column, "bc").Value = hh.Range("C62").Value
 sh.Cells(f.Column, "bd").Value = hh.Range("C63").Value
 sh.Cells(f.Column, "be").Value = hh.Range("C64").Value
 sh.Cells(f.Column, "bf").Value = hh.Range("C65").Value
 sh.Cells(f.Column, "bg").Value = hh.Range("C66").Value
 sh.Cells(f.Column, "bh").Value = hh.Range("C67").Value
 sh.Cells(f.Column, "bi").Value = hh.Range("C68").Value
 sh.Cells(f.Column, "bj").Value = hh.Range("C69").Value
 sh.Cells(f.Column, "bk").Value = hh.Range("C70").Value
 sh.Cells(f.Column, "bm").Value = hh.Range("C73").Value
 sh.Cells(f.Column, "bn").Value = hh.Range("C74").Value
 sh.Cells(f.Column, "bo").Value = hh.Range("C75").Value
 sh.Cells(f.Column, "bp").Value = hh.Range("C76").Value

 End If
 End Sub

你的方案完全可行，核心逻辑（匹配工作表、匹配月份列、复制对应数据）没问题。原代码后半部分的问题主要是**Cells的行参数混用了字符串和数字**，比如"i"、"j"这类列标字符串被错误当成了行号参数，Cells的语法是Cells(行号, 列号/列标)，所以你把列标写到了行号的位置，这会导致赋值错误。

另外，大量重复的赋值语句可以用数组映射简化，提升代码可读性和维护性。以下是完善后的代码：

Sub Copy_Data()
    Dim hh As Worksheet, sh As Worksheet
    Dim f As Range
    Dim rowColMap As Variant
    Dim i As Integer
    
    ' 初始化Form工作表对象
    Set hh = Sheets("Form")
    
    ' 空值校验
    If hh.Range("C5") = "" Then
        MsgBox "请选择年份", vbCritical
        Exit Sub
    End If
    If hh.Range("C6") = "" Then
        MsgBox "请选择月份", vbCritical
        Exit Sub
    End If
    
    ' 匹配目标工作表
    On Error Resume Next
    Set sh = Sheets(hh.Range("C5").Value)
    On Error GoTo 0
    If sh Is Nothing Then
        MsgBox "目标工作表不存在", vbCritical
        Exit Sub
    End If
    
    ' 匹配目标列（E2:P2区域的月份）
    Set f = sh.Range("E2:P2").Find(hh.Range("C6").Value, , xlValues, xlWhole)
    If f Is Nothing Then
        MsgBox "未找到对应月份", vbCritical
        Exit Sub
    End If
    
    ' 定义行号与来源单元格的映射数组：(目标行号, 来源单元格地址)
    rowColMap = Array( _
        Array(3, "C8"), Array(5, "C10"), Array(6, "C11"), Array(8, "C14"), _
        Array(9, "C15"), Array(10, "C16"), Array(11, "C17"), Array(12, "C18"), _
        Array(13, "C20"), Array(15, "C21"), Array(16, "C22"), Array(17, "C23"), _
        Array(19, "C24"), Array(22, "C27"), Array(23, "C28"), Array(24, "C29"), _
        Array(25, "C30"), Array(26, "C31"), Array(28, "C34"), Array(29, "C35"), _
        Array(30, "C36"), Array(32, "C39"), Array(33, "C40"), Array(34, "C41"), _
        Array(36, "C44"), Array(37, "C45"), Array(38, "C46"), Array(39, "C47"), _
        Array(44, "C50"), Array(45, "C51"), Array(46, "C52"), Array(49, "C55"), _
        Array(50, "C56"), Array(52, "C59"), Array(53, "C60"), Array(54, "C61"), _
        Array(55, "C62"), Array(56, "C63"), Array(57, "C64"), Array(58, "C65"), _
        Array(59, "C66"), Array(60, "C67"), Array(61, "C68"), Array(62, "C69"), _
        Array(63, "C70"), Array(65, "C73"), Array(66, "C74"), Array(67, "C75"), _
        Array(68, "C76") _
    )
    
    ' 批量赋值
    For i = LBound(rowColMap) To UBound(rowColMap)
        sh.Cells(rowColMap(i)(0), f.Column).Value = hh.Range(rowColMap(i)(1)).Value
    Next i
    
    MsgBox "数据复制完成", vbInformation
End Sub

关键修改点： #

1. 修正Cells参数错误：把原代码中错误的列标字符串（如"i"）转换成对应的行号数字（如9）
2. 简化工作表匹配逻辑：用On Error Resume Next替代循环遍历，更高效
3. 数组映射批量赋值：把所有复制规则放到数组里，用循环批量处理，避免重复代码，后期修改只需调整数组即可
4. 中文提示框：把英文提示改成中文，更符合使用习惯
5. 添加完成提示：复制成功后弹出提示，明确操作结果

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