基于当前月份将Sheet1绩效数据导入Sheet2对应列的VBA实现求助

以下是满足需求的VBA代码，直接复制到你的Excel模块中即可使用：

Sub ExportPerformanceToSheet2()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim currentMonth As Integer, currentYear As Integer
    Dim targetColStart As Integer
    Dim lastRow As Integer
    Dim monthNames As Variant
    Dim i As Integer
    
    ' 定义中文月份名称
    monthNames = Array("一月", "二月", "三月", "四月", "五月", "六月", _
                      "七月", "八月", "九月", "十月", "十一月", "十二月")
    
    ' 绑定工作表对象
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
    
    ' 获取当前年、月
    currentYear = Year(Date)
    currentMonth = Month(Date)
    
    ' 定位Sheet2中对应月份的起始列
    targetColStart = 0
    With wsTarget.Rows(1)
        ' 遍历表头查找对应月份的姓名列
        For i = 1 To .Columns.Count
            If .Cells(1, i).Value = monthNames(currentMonth - 1) & "-姓名" Then
                targetColStart = i
                Exit For
            End If
        Next i
        
        ' 未找到表头时自动创建
        If targetColStart = 0 Then
            targetColStart = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
            wsTarget.Cells(1, targetColStart).Value = monthNames(currentMonth - 1) & "-姓名"
            wsTarget.Cells(1, targetColStart + 1).Value = monthNames(currentMonth - 1) & "-分数"
            wsTarget.Cells(1, targetColStart + 2).Value = monthNames(currentMonth - 1) & "-平均分"
            ' 表头格式化（可选）
            With wsTarget.Range(wsTarget.Cells(1, targetColStart), wsTarget.Cells(1, targetColStart + 2))
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
        End If
    End With
    
    ' 确定数据源有效行数（限制最大到29行）
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    If lastRow > 29 Then lastRow = 29
    
    ' 清空目标列已有数据（自动实现年度一月覆盖逻辑）
    wsTarget.Range(wsTarget.Cells(5, targetColStart), wsTarget.Cells(wsTarget.Rows.Count, targetColStart + 2)).ClearContents
    
    ' 复制数据到目标区域
    wsSource.Range("B5:B" & lastRow).Copy Destination:=wsTarget.Cells(5, targetColStart)
    wsSource.Range("J5:J" & lastRow).Copy Destination:=wsTarget.Cells(5, targetColStart + 1)
    wsSource.Range("L5:L" & lastRow).Copy Destination:=wsTarget.Cells(5, targetColStart + 2)
    
    ' 同步数据源格式（可选）
    wsTarget.Range(wsTarget.Cells(5, targetColStart), wsTarget.Cells(lastRow, targetColStart + 2)).NumberFormat = wsSource.Range("B5:L5").NumberFormat
    
    MsgBox "数据已成功导出到" & monthNames(currentMonth - 1) & "对应列！", vbInformation
End Sub

关键细节说明： #

• 月份匹配逻辑：自动识别Sheet2第一行的[月份]-姓名表头，无对应表头时自动在末尾添加完整的月份数据列组
• 数据覆盖规则：每次运行都会清空目标月份的已有数据再写入，新年度一月运行时会自动覆盖上一年一月的数据（因表头名称一致）
• 动态行范围：自动捕捉Sheet1姓名列的最后有效行，同时限制最大行到29，避免空行和超出指定范围
• 格式兼容：可选同步数据源的单元格格式，保证导出后数据显示一致

使用步骤： #

1. 打开Excel文件，按下Alt + F11打开VBA编辑器
2. 右键左侧工作簿名称，选择「插入」→「模块」
3. 将上述代码粘贴到模块中
4. 按下F5运行代码，或回到Excel界面添加按钮关联该宏

内容的提问来源于stack exchange，提问作者Martin Vestenkjær