Excel技术问题：跨表转置数据复制及命令按钮复制异常排查

1. 如何将转置后的数据从一个工作表复制到另一个工作表？ #

不管是手动操作还是自动化实现，都有简单可行的方法：

手动操作步骤 #

• 选中需要转置的单元格区域，按Ctrl+C复制
• 切换到目标工作表，选中要粘贴的起始单元格
• 右键点击，选择粘贴选项里的「转置」（旋转箭头图标）；或者按Ctrl+Alt+V调出粘贴特殊对话框，勾选「转置」后确认即可

VBA自动化实现 #

如果需要批量或重复执行，用这段代码就可以：

Sub TransposeCopyData()
    ' 定义源工作表和要转置的区域
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Sheets("源工作表名") ' 替换成你的源表名称
    Dim sourceRange As Range
    Set sourceRange = sourceSheet.Range("A1:C3") ' 替换成你要转置的具体区域
    
    ' 定义目标工作表和粘贴起始位置
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets("目标工作表名") ' 替换成你的目标表名称
    Dim targetStartCell As Range
    Set targetStartCell = targetSheet.Range("E1") ' 替换成目标表的起始单元格
    
    ' 执行转置粘贴
    sourceRange.Copy
    targetStartCell.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Application.CutCopyMode = False ' 清除复制状态
End Sub

2. 修复命令按钮数据重复粘贴的问题 #

从你的描述和代码片段来看，核心问题是目标行号的计算语法错误——你写的Range("F&...")是不正确的字符串拼接方式，导致部分数据始终指向同一行，才会出现重复覆盖的情况。下面是修正后的完整代码：

Sub Submit()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim nextEmptyRow As Long
    Dim sourceRanges As Variant
    Dim pasteCol As Integer
    Dim i As Integer
    
    ' 替换成你实际的源工作表名称
    Set sourceWs = ThisWorkbook.Sheets("你的源工作表名")
    ' 目标工作表是JANUARY，不用改
    Set targetWs = ThisWorkbook.Sheets("JANUARY")
    
    ' 找到JANUARY表F列的下一个空行（如果要以其他列判断空行，把"F"改成对应列标即可）
    nextEmptyRow = targetWs.Cells(targetWs.Rows.Count, "F").End(xlUp).Row + 1
    
    ' 这里可以添加多个要复制的单元格区域，按顺序排列
    sourceRanges = Array("E6:E27") ' 比如还可以加 ", "G6:G15"" 这类区域
    
    ' 从F列开始粘贴（F是第6列）
    pasteCol = 6
    
    ' 逐个处理每个源区域，转置后粘贴到目标行的对应列
    For i = LBound(sourceRanges) To UBound(sourceRanges)
        sourceWs.Range(sourceRanges(i)).Copy
        ' 粘贴时保留源格式，同时转置成单行
        targetWs.Cells(nextEmptyRow, pasteCol).PasteSpecial _
            Paste:=xlPasteAllUsingSourceTheme, Transpose:=True
        ' 计算下一个粘贴的列位置（根据源区域的行数调整）
        pasteCol = pasteCol + sourceWs.Range(sourceRanges(i)).Rows.Count
    Next i
    
    ' 清除复制状态
    Application.CutCopyMode = False
    ' 可选：自动选中新粘贴的行，方便查看
    targetWs.Rows(nextEmptyRow).Select
End Sub

关键修复点 #

• 正确计算空行：用End(xlUp).Row +1确保每次都定位到真正的下一个空行，不会重复覆盖已有数据
• 列位置动态调整：每次粘贴后根据源区域的行数更新下一个粘贴列，保证所有数据按单行水平排列
• 保留表格格式：使用xlPasteAllUsingSourceTheme粘贴，确保新行完全延续原有表格的格式
• 修正语法错误：替换了之前错误的字符串拼接方式，用Cells(nextEmptyRow, pasteCol)更精准可靠

使用前记得把代码里的「你的源工作表名」替换成实际名称，测试前建议先备份数据哦！

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