VBA复制非一致单元格到另一工作簿空白行报错及转置实现求助

原代码的两个核心问题 #

1. Set copy_to 报错：大概率是目标工作簿未打开、文件名未写全（比如缺少.xlsx后缀），或者工作表名称拼写错误。
2. 非连续单元格复制顺序不对：直接复制Range("K33,A36,G32,G53")时，Excel会按单元格在工作表中的固有顺序（A列在前，G列次之，K列最后）排列，不会遵循你指定的顺序；且直接粘贴会保留原单元格的分散布局，无法横向填充到一行的A-D列。

修正方案一：直接赋值（高效且精准） #

不用复制粘贴，直接把对应单元格的值写入目标位置，完全可控顺序：

Sub copy_wb()
    Dim sourceWb As Workbook
    Dim destWb As Workbook
    Dim sourceWs As Worksheet
    Dim destWs As Worksheet
    Dim nextBlankRow As Long
    
    ' 检查源/目标工作簿是否打开（记得加文件后缀，比如.xlsx/.xlsm）
    On Error Resume Next
    Set sourceWb = Workbooks("FNOL Notes Doc Tool.xlsx")
    Set destWb = Workbooks("Locate Form.xlsx")
    On Error GoTo 0
    
    ' 工作簿未打开则提示退出
    If sourceWb Is Nothing Or destWb Is Nothing Then
        MsgBox "请确认两个工作簿都已正常打开！"
        Exit Sub
    End If
    
    ' 指定要操作的工作表
    Set sourceWs = sourceWb.Worksheets("CSR Notes")
    Set destWs = destWb.Worksheets("Data")
    
    ' 计算目标工作表A列的下一个空白行
    nextBlankRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 按要求顺序逐个赋值
    destWs.Cells(nextBlankRow, "A").Value = sourceWs.Range("K33").Value
    destWs.Cells(nextBlankRow, "B").Value = sourceWs.Range("A36").Value
    destWs.Cells(nextBlankRow, "C").Value = sourceWs.Range("G3").Value ' 原代码写的是G32，按你的需求改成G3了
    destWs.Cells(nextBlankRow, "D").Value = sourceWs.Range("G53").Value
End Sub

修正方案二：带格式复制粘贴（需保留格式时用） #

如果需要复制单元格的格式（比如字体、颜色），可以用临时区域整理顺序后转置粘贴：

Sub copy_wb_with_format()
    Dim sourceWb As Workbook
    Dim destWb As Workbook
    Dim sourceWs As Worksheet
    Dim destWs As Worksheet
    Dim nextBlankRow As Long
    Dim tempRange As Range
    
    ' 检查工作簿是否打开
    On Error Resume Next
    Set sourceWb = Workbooks("FNOL Notes Doc Tool.xlsx")
    Set destWb = Workbooks("Locate Form.xlsx")
    On Error GoTo 0
    
    If sourceWb Is Nothing Or destWb Is Nothing Then
        MsgBox "请确认两个工作簿都已正常打开！"
        Exit Sub
    End If
    
    Set sourceWs = sourceWb.Worksheets("CSR Notes")
    Set destWs = destWb.Worksheets("Data")
    nextBlankRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 用源表空白区域（比如Z1:Z4）临时存放要复制的内容，按顺序排列
    Set tempRange = sourceWs.Range("Z1:Z4")
    tempRange(1).Value = sourceWs.Range("K33").Value
    tempRange(2).Value = sourceWs.Range("A36").Value
    tempRange(3).Value = sourceWs.Range("G3").Value
    tempRange(4).Value = sourceWs.Range("G53").Value
    
    ' 转置复制到目标行的A-D列，保留所有格式
    tempRange.Copy
    destWs.Cells(nextBlankRow, "A").PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Application.CutCopyMode = False
    
    ' 清空临时区域
    tempRange.ClearContents
End Sub

注意事项 #

• 文件名一定要加后缀（比如.xlsx），启用宏的工作簿用.xlsm
• 原代码里的G32和你需求里的G3不一致，已按需求修改，若实际需要G32改回即可
• 工作表名称有空格或特殊字符时，确保拼写完全一致

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