如何在VBA中从原工作簿活动行复制指定列数据至新工作簿？

我有一段通过宏按钮触发的VBA代码，功能是基于模板新建工作簿，并用原工作簿活动行H列的作业地址作为文件名保存。打开新工作簿后，想把原工作簿活动行特定列的信息复制粘贴到新工作簿里，但现在实现不了，推测是打开新工作簿后，活动对象切换到了新工作簿，导致无法正确获取原工作簿的活动行数据。

原代码如下：

Sub CREATE_REINTSTATEMENT_SHEET()

'I want to open a new workbook from the reinstatement template
Dim wb As Workbook, wb2 As Workbook
Dim Loc As String
Dim FileSaveName As String
Dim fPath As String
Dim row As Integer

Set wb = ActiveWorkbook
row = ActiveCell.row
Loc = wb.Worksheets("Sheet1").Cells(row, 8)
fPath = "filepath"

'I want this to save in a specific file location with the filename being the address taken from the planning sheet
Set wb2 = Workbooks.Add("filepath.xlsx")
wb2.SaveAs Filename:=fPath & Loc & ".xlsm", FileFormat:=52

'Next, copy info from planning sheet active row into reinstatement sheet
'To do this, i first have to set the planner sheet as the active workbook again
Set wb = ActiveWorkbook
row = ActiveCell.row

'CLIENT
wb.Worksheets("Sheet1").Cells(row, 4).Copy
wb2.Worksheets("Sheet1").Cells(5, 23).PasteSpecial xlPasteValues

'WI NO
wb.Worksheets("Sheet1").Cells(row, 5).Copy
wb2.Worksheets("Sheet1").Cells(5, 18).PasteSpecial xlPasteValues

'POSTCODE
wb.Worksheets("Sheet1").Cells(row, 10).Copy
wb2.Worksheets("Sheet1").Cells(6, 18).PasteSpecial xlPasteValues

'NED
wb.Worksheets("Sheet1").Cells(row, 7).Copy
wb2.Worksheets("Sheet1").Cells(6, 23).PasteSpecial xlPasteValues

'AREA
wb.Worksheets("Sheet1").Cells(row, 9).Copy
wb2.Worksheets("Sheet1").Cells(5, 14).PasteSpecial xlPasteValues

'FULL ADDRESS
wb.Worksheets("Sheet1").Cells(row, 8).Copy
wb2.Worksheets("Sheet1").Cells(6, 7).PasteSpecial xlPasteValues

'DATE REQ
wb.Worksheets("Sheet1").Cells(row, 11).Copy
wb2.Worksheets("Sheet1").Cells(5, 7).PasteSpecial xlPasteValues

'PUBLIC
wb.Worksheets("Sheet1").Cells(row, 24).Copy
wb2.Worksheets("Sheet1").Cells(10, 2).PasteSpecial xlPasteValues

'MATERIAL
wb.Worksheets("Sheet1").Cells(row, 26).Copy
wb2.Worksheets("Sheet1").Cells(10, 11).PasteSpecial xlPasteValues

'ROAD TYPE
wb.Worksheets("Sheet1").Cells(row, 27).Copy
wb2.Worksheets("Sheet1").Cells(10, 13).PasteSpecial xlPasteValues

'LENGTH
wb.Worksheets("Sheet1").Cells(row, 29).Copy
wb2.Worksheets("Sheet1").Cells(10, 14).PasteSpecial xlPasteValues

'WIDTH
wb.Worksheets("Sheet1").Cells(row, 30).Copy
wb2.Worksheets("Sheet1").Cells(10, 15).PasteSpecial xlPasteValues

'DEPTH
wb.Worksheets("Sheet1").Cells(row, 31).Copy
wb2.Worksheets("Sheet1").Cells(10, 16).PasteSpecial xlPasteValues

End Sub

原工作簿待复制活动行区域：

新工作簿粘贴目标区域：

问题根源 #

你代码里的核心错误是：打开新工作簿后，重新执行了Set wb = ActiveWorkbook和row = ActiveCell.row，此时ActiveWorkbook已经是新建的wb2，ActiveCell也是新工作簿里的单元格，自然拿不到原工作簿的活动行数据。只需要保留一开始获取的原工作簿活动行号，不需要重新获取。

另外，用Copy/PasteSpecial效率较低，直接赋值单元格值的方式更高效稳定。

修改后的代码 #

Sub CREATE_REINTSTATEMENT_SHEET()
    ' 声明变量：用Long避免行号超过Integer范围（Excel行号最大1048576）
    Dim wbSource As Workbook, wbTarget As Workbook
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim strSavePath As String
    Dim strFileName As String
    Dim lngActiveRow As Long
    
    ' 绑定原工作簿和工作表，避免依赖Active状态
    Set wbSource = ActiveWorkbook
    Set wsSource = wbSource.Worksheets("Sheet1")
    lngActiveRow = ActiveCell.Row
    
    ' 获取保存路径和文件名（请替换为你的实际路径和模板路径）
    strSavePath = "C:\你的保存路径\" ' 注意末尾加斜杠
    strFileName = wsSource.Cells(lngActiveRow, 8).Value ' H列地址
    
    ' 基于模板新建工作簿
    Set wbTarget = Workbooks.Add("C:\你的模板文件路径\模板.xlsx")
    ' 保存为启用宏的工作簿
    wbTarget.SaveAs Filename:=strSavePath & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    ' 绑定目标工作表
    Set wsTarget = wbTarget.Worksheets("Sheet1")
    
    ' 直接赋值单元格值，替代Copy/Paste，提升效率
    ' CLIENT：原D列 → 目标V列第5行（列号23）
    wsTarget.Cells(5, 23).Value = wsSource.Cells(lngActiveRow, 4).Value
    ' WI NO：原E列 → 目标R列第5行（列号18）
    wsTarget.Cells(5, 18).Value = wsSource.Cells(lngActiveRow, 5).Value
    ' POSTCODE：原J列 → 目标R列第6行
    wsTarget.Cells(6, 18).Value = wsSource.Cells(lngActiveRow, 10).Value
    ' NED：原G列 → 目标V列第6行
    wsTarget.Cells(6, 23).Value = wsSource.Cells(lngActiveRow, 7).Value
    ' AREA：原I列 → 目标N列第5行（列号14）
    wsTarget.Cells(5, 14).Value = wsSource.Cells(lngActiveRow, 9).Value
    ' FULL ADDRESS：原H列 → 目标G列第6行
    wsTarget.Cells(6, 7).Value = wsSource.Cells(lngActiveRow, 8).Value
    ' DATE REQ：原K列 → 目标G列第5行
    wsTarget.Cells(5, 7).Value = wsSource.Cells(lngActiveRow, 11).Value
    ' PUBLIC：原X列 → 目标B列第10行
    wsTarget.Cells(10, 2).Value = wsSource.Cells(lngActiveRow, 24).Value
    ' MATERIAL：原Z列 → 目标K列第10行
    wsTarget.Cells(10, 11).Value = wsSource.Cells(lngActiveRow, 26).Value
    ' ROAD TYPE：原AA列 → 目标M列第10行（列号13）
    wsTarget.Cells(10, 13).Value = wsSource.Cells(lngActiveRow, 27).Value
    ' LENGTH：原AC列 → 目标N列第10行
    wsTarget.Cells(10, 14).Value = wsSource.Cells(lngActiveRow, 29).Value
    ' WIDTH：原AD列 → 目标O列第10行
    wsTarget.Cells(10, 15).Value = wsSource.Cells(lngActiveRow, 30).Value
    ' DEPTH：原AE列 → 目标P列第10行
    wsTarget.Cells(10, 16).Value = wsSource.Cells(lngActiveRow, 31).Value
    
    ' 可选：激活原工作簿，提升用户体验
    wbSource.Activate
End Sub

关键修改点 #

• 保留初始行号：只在开头获取一次原工作簿的活动行号lngActiveRow，全程使用这个值，不再重新获取
• 明确对象引用：绑定具体的工作簿和工作表对象，避免依赖ActiveWorkbook/ActiveCell这类易变的状态
• 替换复制粘贴：用直接赋值Value的方式替代Copy/PasteSpecial，代码更简洁，运行速度更快
• 变量优化：把row改成lngActiveRow，类型从Integer改为Long，避免因行号超过Integer最大值（32767）导致溢出
• 常量替换：用xlOpenXMLWorkbookMacroEnabled替代数字52，代码可读性更高

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