如何基于实际日期将指定单元格区域复制粘贴至对应年份工作表的对应月份列？

我来帮你搞定这个根据当前日期自动定位目标工作表和列的需求！你的现有代码已经处理了工作表保护的逻辑，现在只需要加上日期匹配工作表+列的核心逻辑就行，下面一步步给你说明：

核心逻辑拆解 #

要实现你的需求，我们需要从当前日期里提取两个关键信息：

• 年份：直接对应「2022」「2023」这类年份命名的工作表
• 月份：月份数字正好对应Excel的列号（比如4月=第4列=D列，7月=第7列=G列，完美匹配你的需求）

然后把「Current Standing」的D12:D35区域，粘贴到对应工作表的目标列第3行开始的位置即可。

修改后的完整VBA代码 #

Option Explicit
Sub UpdateCurrentStandingToYearSheet()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim sourceRange As Range
    Dim targetCol As Integer
    Dim targetStartRow As Integer
    Dim currentYear As String
    
    ' 初始化变量
    Set sourceWs = ThisWorkbook.Worksheets("Current Standing")
    Set sourceRange = sourceWs.Range("D12:D35")
    targetStartRow = 3 ' 从第3行开始粘贴
    currentYear = CStr(Year(Date)) ' 获取当前年份，转为字符串匹配工作表名
    targetCol = Month(Date) ' 获取当前月份，直接作为目标列号（1=A,4=D,7=G...）
    
    On Error Resume Next
    Set targetWs = ThisWorkbook.Worksheets(currentYear)
    On Error GoTo 0
    
    ' 检查目标工作表是否存在
    If targetWs Is Nothing Then
        MsgBox "未找到名为" & currentYear & "的工作表，请确认！", vbExclamation
        Exit Sub
    End If
    
    ' 处理源工作表保护，复制数据
    If sourceWs.ProtectContents = True Then
        sourceWs.Unprotect
        sourceRange.Copy
        sourceWs.Protect
    Else
        sourceRange.Copy
    End If
    
    ' 处理目标工作表保护，粘贴数据（如果目标表有保护的话）
    If targetWs.ProtectContents = True Then
        targetWs.Unprotect
        targetWs.Cells(targetStartRow, targetCol).Resize(sourceRange.Rows.Count, 1).PasteSpecial xlPasteValues
        targetWs.Protect
    Else
        targetWs.Cells(targetStartRow, targetCol).Resize(sourceRange.Rows.Count, 1).PasteSpecial xlPasteValues
    End If
    
    ' 清除剪贴板，避免残留
    Application.CutCopyMode = False
    MsgBox "数据已成功同步到" & currentYear & "工作表的第" & targetCol & "列（" & Chr(64 + targetCol) & "列）！", vbInformation
End Sub

关键代码说明 #

• Year(Date)：获取当前系统日期的年份，转为字符串后直接匹配你的年份工作表名
• Month(Date)：获取当前月份（1-12），因为Excel列号A=1、B=2...D=4，正好和你的月份对应列的需求完全匹配
• Resize(sourceRange.Rows.Count, 1)：自动匹配源区域的行数（D12:D35共24行），避免手动写死行数，更灵活
• 加入了目标工作表存在性检查：如果当前年份的工作表不存在，会弹出提示，避免报错
• 同时处理了目标工作表的保护逻辑：如果目标年份工作表有保护，会先解除再粘贴，完成后重新保护（如果你的目标表不需要保护，可以删掉这部分）

测试场景验证 #

• 今日（4月）运行：会将D12:D35复制到「2022」工作表的D列（第4列）第3行开始
• 7月运行：复制到「2022」工作表的G列（第7列）第3行开始
• 2023年4月运行：复制到「2023」工作表的D列第3行开始

完全符合你提出的需求！

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