如何编写Excel宏实现跨工作表复制表格列至F2指定的目标列？

需求说明 #

我有两个工作表，每周在其中一个工作表的某列输入数据，周末需将这些数据复制到另一个工作表的指定表格列中，之后清空原列内容以录入新数据。需要宏支持通过单元格F2的引用指定目标列，录制宏未成功，现有尝试代码如下：

Range("TM[Net]").Select
Selection.Copy
Sheets("C").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("H9").Select
Sheets("M").Select
Range("G5").Select
Application.CutCopyMode = False
Sheets("C").Select
End Sub

改进后的宏代码 #

原代码依赖Select/Activate操作，效率低且易出错，同时未利用F2单元格指定目标列。以下是优化后的代码：

Sub CopyAndClearData()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetCol As String
    Dim targetLastRow As Long
    Dim sourceLastRow As Long
    
    ' 替换为你的实际工作表名称
    Set sourceSheet = ThisWorkbook.Sheets("M")
    Set targetSheet = ThisWorkbook.Sheets("C")
    
    ' 读取目标工作表F2单元格的列标识（如"D"对应D列）
    targetCol = targetSheet.Range("F2").Value
    
    ' 获取原数据列的最后一行（基于结构化表格"TM"的"Net"列）
    With sourceSheet.ListObjects("TM").ListColumns("Net").Range
        sourceLastRow = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        ' 定义要复制的范围（跳过表头）
        Set sourceRange = .Offset(1).Resize(sourceLastRow - .HeaderRowRange.Row)
    End With
    
    ' 找到目标列的下一个空行
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, targetCol).End(xlUp).Row + 1
    
    ' 仅粘贴值到目标列
    sourceRange.Copy
    targetSheet.Cells(targetLastRow, targetCol).PasteSpecial Paste:=xlPasteValues
    
    ' 清空原数据列内容
    sourceRange.ClearContents
    
    ' 取消复制状态
    Application.CutCopyMode = False
End Sub

关键说明 #

• 工作表名称适配：如果你的原数据工作表不是"M"、目标工作表不是"C"，请修改代码中Set sourceSheet和Set targetSheet的工作表名称
• 表格与列名确认：代码默认原数据在名为TM的结构化表格的Net列，与你原代码的引用一致，若结构变动请对应调整
• 目标列动态指定：targetCol = targetSheet.Range("F2").Value会读取目标工作表F2单元格的内容（例如输入"E"就会将数据粘贴到E列）
• 避免数据覆盖：自动定位目标列的下一个空行，不会覆盖已有数据
• 高效稳定：移除Select/Activate操作，提升宏的运行效率和可靠性

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