VBA剪切粘贴转置循环脚本开发需求及现有代码问题咨询

需求与问题 #

• 目标：在HR TEST.xlsm的Evaluation工作表添加按钮，每次点击从Report.xlsx的Injury工作表提取下一行指定范围（A-G列，对应姓名、职位、收入等）数据，转置后覆盖评估表单现有数据。
• 当前问题：现有脚本无法实现“每次提取下一行”逻辑，且跨工作表操作存在逻辑漏洞，固定提取A2行数据，清除目标区域的逻辑错误。

现有代码 #

Set wsCopy = Workbooks("Report.xlsx").Worksheets("Injury")
Set wsDest = Workbooks("HR TEST.xlsm").Worksheets("Evaluation")
  
'1. 获取源数据最后一行（基于A列）
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
  
'2. 获取目标表第一个空行（基于A列）
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
  
' 转置复制粘贴逻辑
With wsCopy
    
  
'3. 清除目标区域现有内容
wsDest.Range("A2:G" & lDestLastRow).ClearContents

'4. 复制粘贴并转置
wsCopy.Range("A2:G2").Copy
wsDest.Range("A2").PasteSpecial Transpose:=True

代码问题分析 #

1. With wsCopy语句无实际作用且未闭合（缺少End With），但这不是跨工作表操作失败的原因。
2. 未记录上次提取的行号，无法实现“每次点击提取下一行”的循环逻辑。
3. 清除目标区域的逻辑错误：lDestLastRow是目标表的第一个空行，用它清除A2:G&lDestLastRow只会清除到空行前一行，不符合“覆盖全部现有数据”的需求。
4. 固定提取A2:G2行，未实现行号递增遍历。

修正后的代码 #

Sub ExtractNextRowTranspose()
    Dim wsCopy As Worksheet, wsDest As Worksheet
    Dim lastCopyRow As Long, currentExtractRow As Long
    
    ' 绑定源工作表与目标工作表
    Set wsCopy = Workbooks("Report.xlsx").Worksheets("Injury")
    Set wsDest = Workbooks("HR TEST.xlsm").Worksheets("Evaluation")
    
    ' 获取源数据最后一行（基于A列）
    lastCopyRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
    ' 读取上次提取的行号（存储在目标表最右侧隐藏单元格XFD1，避免干扰表单）
    If wsDest.Range("XFD1").Value = "" Then
        currentExtractRow = 2 ' 首次运行从第2行开始（跳过表头）
    Else
        currentExtractRow = wsDest.Range("XFD1").Value + 1
    End If
    
    ' 循环逻辑：到达最后一行后回到第2行
    If currentExtractRow > lastCopyRow Then
        currentExtractRow = 2
    End If
    
    ' 清除目标表需要覆盖的区域（转置后A2-A8对应源A-G列，可按需调整范围）
    wsDest.Range("A2:A8").ClearContents
    
    ' 提取当前行数据并转置粘贴到目标区域
    wsCopy.Range("A" & currentExtractRow & ":G" & currentExtractRow).Copy
    wsDest.Range("A2").PasteSpecial Transpose:=True
    
    ' 保存当前提取的行号，供下次点击使用
    wsDest.Range("XFD1").Value = currentExtractRow
    
    ' 取消复制状态，释放剪贴板
    Application.CutCopyMode = False
End Sub

关键说明 #

• 用目标表的XFD1单元格存储上次提取的行号：该列是Excel最右侧的隐藏列，不会影响表单正常使用；也可改用名称管理器存储此值。
• 自动循环逻辑：每次点击后行号递增，到达源数据最后一行后自动回到第2行，实现循环提取。
• 目标区域固定为A2:A8：对应源表A-G列转置后的7行数据，可根据实际字段数量调整范围。
• 跨工作表操作直接通过wsCopy和wsDest对象完成，无权限限制，去掉了无用的With语句。

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