VBA代码修改需求：复制单元格区域而非单个单元格

需求说明 #

有两个工作表：

• 「C0 EV (Historie)」：数据存储表，S2开始的横向列是日期，需将对应日期列从第3行开始的区域，替换为源表的KPI数据
• 「C1 EV Application」：数据录入表，需复制AD5:AD25的整个区域，匹配目标表的日期列完成粘贴

原代码仅支持单值复制，调整Resize后仍无法实现区域复制，需修正代码逻辑。

修正后的完整代码 #

Sub Progress_speichern()

    Const SRC_NAME As String = "C1 EV Application"
    Const SRC_DATE_CELL As String = "C2"
    Const SRC_KPI_RANGE As String = "AD5:AD25" ' 明确源KPI区域
    Const DST_NAME As String = "C0 EV (Historie)"
    Const DST_DATES_LEFT_CELL As String = "S2"
    Const DST_KPI_START_ROW As Long = 3 ' 修改变量名更清晰

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    
    ' 读取源日期和KPI区域数据（数组形式，提升效率）
    Dim sDate As Date: sDate = sws.Range(SRC_DATE_CELL).Value
    Dim srg As Variant: srg = sws.Range(SRC_KPI_RANGE).Value
    Dim srcRowCount As Long: srcRowCount = UBound(srg, 1) ' 获取源区域行数（21行）

    ' 定位目标表的日期行区域
    Dim drrg As Range
    With dws.Range(DST_DATES_LEFT_CELL)
        Dim LastCol As Long
        LastCol = dws.Cells(.Row, dws.Columns.Count).End(xlToLeft).Column
        Set drrg = .Resize(, LastCol - .Column + 1)
    End With

    ' 匹配日期列的索引
    Dim cIndex As Variant: cIndex = Application.Match(CLng(sDate), drrg, 0)
    
    ' 检查是否找到匹配日期
    If IsError(cIndex) Then
        MsgBox "未找到对应日期列", vbExclamation
        Exit Sub
    End If

    ' 定义目标区域：匹配日期列，从起始行开始，行数和源区域一致
    Dim dstTargetRange As Range
    Set dstTargetRange = dws.Cells(DST_KPI_START_ROW, drrg.Cells(cIndex).Column).Resize(srcRowCount)

    ' 检查目标区域是否已有数据
    If Application.CountA(dstTargetRange) > 0 Then
        If MsgBox("Für diesen Monat gibt es bereits alte Werte. Wollen Sie diese überschreiben?", _
                  vbYesNo + vbQuestion, "Alte Werte gefunden") = vbNo Then
            Exit Sub
        End If
    End If

    ' 执行区域赋值（数组直接赋值，高效且对应正确）
    dstTargetRange.Value = srg

End Sub

关键改动点 #

• 明确区域尺寸匹配：获取源区域的行数，在目标表中Resize出相同行数的区域，确保数组赋值时每个元素对应正确位置
• 修正目标区域定位：不再通过drrg的行列索引间接定位，直接通过匹配到的日期列号+起始行，精准定位目标区域
• 优化判断逻辑：用CountA检查目标区域是否有数据，替代原单单元格判断，更符合区域复制的场景
• 增加错误处理：如果未找到匹配日期，直接提示并退出，避免后续代码报错

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