Excel VBA宏开发需求：每月复制列值至新工作表新列

我来帮你调整这个VBA宏，让它每次运行时自动定位到对应历史工作表的最后一列的右侧新列，把当前D、E列的方差数据复制过去，不用再手动指定列号啦。

下面是修改后的完整代码，我会逐段解释关键逻辑：

Sub CopyVarianceToHistoricalSheets()
    Dim wsSource As Worksheet
    Dim wsLoanCount As Worksheet
    Dim wsUPB As Worksheet
    Dim lastColLoan As Long
    Dim lastColUPB As Long
    Dim sourceRangeD As Range
    Dim sourceRangeE As Range
    
    ' 定义源工作表（就是当前存放D、E列方差的表）
    Set wsSource = ThisWorkbook.ActiveSheet
    ' 定义两个历史工作表
    Set wsLoanCount = ThisWorkbook.Worksheets("Historical loan count")
    Set wsUPB = ThisWorkbook.Worksheets("Historical UPB")
    
    ' 动态获取D列和E列的有效数据范围（从第1行到最后一行有数据的行）
    Set sourceRangeD = wsSource.Range("D1:D" & wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row)
    Set sourceRangeE = wsSource.Range("E1:E" & wsSource.Cells(wsSource.Rows.Count, "E").End(xlUp).Row)
    
    ' 找到"Historical loan count"的最后一列，新列就是最后一列+1
    lastColLoan = wsLoanCount.Cells(1, wsLoanCount.Columns.Count).End(xlToLeft).Column + 1
    ' 找到"Historical UPB"的最后一列，新列就是最后一列+1
    lastColUPB = wsUPB.Cells(1, wsUPB.Columns.Count).End(xlToLeft).Column + 1
    
    ' 复制D列值到历史贷款计数表的新列（只复制数值，不带公式）
    sourceRangeD.Copy
    wsLoanCount.Cells(1, lastColLoan).PasteSpecial Paste:=xlPasteValues
    ' 复制E列值到历史UPB表的新列
    sourceRangeE.Copy
    wsUPB.Cells(1, lastColUPB).PasteSpecial Paste:=xlPasteValues
    
    ' 清除剪贴板，避免后续操作受影响
    Application.CutCopyMode = False
    MsgBox "方差数据已成功复制到历史工作表的新列！", vbInformation
End Sub

关键逻辑说明： #

• 自动定位新列：用Cells(1, Columns.Count).End(xlToLeft).Column找到工作表第一行的最后一个有数据的列，加1就是我们需要的新列位置——不管之前已经积累了多少列数据，都能精准定位到下一个空白列。
• 复制值而非公式：用PasteSpecial xlPasteValues确保只复制单元格的数值，不会把源列的公式带过去，保证历史数据的稳定性，避免后续源表公式修改影响历史记录。
• 动态获取数据范围：通过wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row获取D列最后一行有数据的行号，这样不管D/E列有多少行数据，都能完整复制，不会漏行也不会复制多余的空行。

额外提示： #

如果你的源工作表不是当前激活的表，可以把Set wsSource = ThisWorkbook.ActiveSheet改成具体的工作表名称，比如Set wsSource = ThisWorkbook.Worksheets("你的源表名称")，这样运行宏时不用切换到源表也能正常工作。

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