VBA Offset单元格左移操作及报表转换时首行丢失问题求助（附代码）

让我帮你定位下代码里的问题——你遇到的第一行被删除/覆盖的情况，核心原因是搞错了Cells对象的参数顺序（Cells的语法是Cells(行号, 列号)，你之前把列数当成行号来用了），导致数据复制的目标区域完全错误，直接覆盖了第一行内容。下面是具体的分析和修正方案：

问题点分析 #

1. Cells参数顺序错误
   你这段复制数据的代码里，把offerLastCol（Offers表的最后列数）当成了行号传入Cells：

   Sheets("Testowy").Range(Sheets("Testowy").Cells(offerLastCol - 1, 1), ...)
   

   比如如果offerLastCol是5，那起始行就变成了4，但你实际可能想从第1行开始复制，这就会导致目标区域错位，甚至直接覆盖第一行的原有内容。

2. On Error Resume Next隐藏了错误
   代码里的On Error Resume Next会让Excel跳过所有错误，你根本看不到参数错误的提示，这会让问题排查变得困难。

修正后的完整代码 #

我调整了参数顺序，明确了复制和转置的目标区域，同时保留了你的核心逻辑：

Sub create_report()
    Dim itemWs As Worksheet, offerWs As Worksheet, testWs As Worksheet
    Dim itemLastRow As Long, offerLastRow As Long
    Dim offerLastCol As Long, itemLastCol As Long
    Dim dataRng As Range
    
    ' 初始化工作表对象（用变量更清晰）
    Set itemWs = ThisWorkbook.Worksheets("nn_rfx_compare_per_lot")
    Set offerWs = ThisWorkbook.Worksheets("Offers")
    Set testWs = ThisWorkbook.Worksheets("Testowy")
    
    ' 获取各表的最后行/列（指定工作表的Rows/Columns，避免使用全局对象的风险）
    itemLastRow = itemWs.Range("A" & itemWs.Rows.Count).End(xlUp).Row
    offerLastRow = offerWs.Range("A" & offerWs.Rows.Count).End(xlUp).Row
    offerLastCol = offerWs.Cells(1, offerWs.Columns.Count).End(xlToLeft).Column
    itemLastCol = itemWs.Cells(1, itemWs.Columns.Count).End(xlToLeft).Column
    
    ' 复制nn_rfx_compare_per_lot的数据到Testowy的A1起始位置（明确不覆盖第一行）
    testWs.Range(testWs.Cells(1, 1), testWs.Cells(itemLastRow, itemLastCol)).Value = _
        itemWs.Range(itemWs.Cells(1, 1), itemWs.Cells(itemLastRow, itemLastCol)).Value
    
    ' 转置Offers表的B列到最后列的数据，粘贴到Testowy的第一行、itemLastCol+1列起始位置
    ' 用Offset自动计算转置后的目标区域大小，避免手动算错
    Dim transposeStart As Range
    Set transposeStart = testWs.Cells(1, itemLastCol + 1)
    testWs.Range(transposeStart, transposeStart.Offset(offerLastCol - 2, offerLastRow - 1)).Value = _
        WorksheetFunction.Transpose(offerWs.Range(offerWs.Cells(1, 2), offerWs.Cells(offerLastRow, offerLastCol)))
    
    ' 获取Testowy的最后列
    Dim lastTestCol As Long
    lastTestCol = testWs.Cells(1, testWs.Columns.Count).End(xlToLeft).Column
    
    ' 填充匹配数据（调试时可以注释On Error Resume Next，方便排查匹配错误）
    ' On Error Resume Next
    Dim Row As Long, Col As Long
    For Row = 6 To 11
        For Col = 9 To lastTestCol
            testWs.Cells(Row, Col).Value = Application.WorksheetFunction.Index( _
                testWs.Cells(5, Col), _
                Application.WorksheetFunction.Match(testWs.Cells(Row, 3).Value, testWs.Cells(3, Col), 0) _
            )
        Next Col
    Next Row
    ' On Error GoTo 0 ' 恢复错误捕获，调试完成后可以打开
    
    ' 清空第5行指定列的内容
    Dim Cl As Long
    For Cl = 9 To lastTestCol
        testWs.Cells(5, Cl).Value = ""
    Next Cl
End Sub

关键修改说明 #

• 修正Cells参数顺序：所有Cells调用都严格遵循Cells(行号, 列号)的语法，确保复制的目标区域位置正确，不会覆盖第一行。
• 用Offset定义转置区域：转置后的区域大小通过Offset自动计算，避免手动计算行列数出错。
• 建议调试时关闭错误跳过：注释掉On Error Resume Next，这样Excel会弹出错误提示，帮助你快速定位匹配逻辑或区域选择的问题。
• 指定工作表的Rows/Columns：避免使用全局的Rows/Columns对象，防止因当前激活工作表变化导致的错误。

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