基于关键字实现跨工作表复制数据的Excel宏创建问题

1. 现有实现方法是否合理？ #

不合理，你的宏代码存在多个逻辑和效率问题：

• 遍历整个A:A列会处理大量空单元格，严重拖慢运行效率，应该只遍历有员工数据的单元格范围。
• 嵌套If逻辑错误：第二个If写在第一个If内部，且没有对应的End If，语法不完整，会导致编译报错。
• 固定复制A1单元格，没有使用遍历的cell对象，等于只复制第一个员工的信息，完全没实现遍历所有员工的需求。
• Exit For位置错误，会导致循环只执行一次就终止，无法处理所有员工。
• 没有动态更新模板表的粘贴位置，每次都覆盖A1或A1:A5，最终只会保留最后一个员工的信息。

2. 正确实现方案 #

下面是修正后的宏代码，能根据Template!D1的关键字（如"1 Week"、"5 Week"）自动提取轮换次数，将每位员工信息重复对应次数复制到模板表：

Sub Generate_Template()
    Dim wsStaff As Worksheet, wsTemplate As Worksheet
    Dim lastRow As Long, i As Long, j As Long, repeatTimes As Long
    Dim keyWord As String
    Dim targetRow As Long
    
    ' 定义工作表对象，简化代码
    Set wsStaff = ThisWorkbook.Worksheets("Staff")
    Set wsTemplate = ThisWorkbook.Worksheets("Template")
    
    ' 获取关键字并提取轮换次数
    keyWord = wsTemplate.Range("D1").Value
    ' 从关键字中提取数字（支持任意数字+Week的格式）
    repeatTimes = Val(Left(keyWord, InStr(keyWord, " ") - 1))
    
    ' 清空模板表已有数据（保留表头的话可调整范围）
    wsTemplate.Cells.ClearContents
    targetRow = 1 ' 从模板表第1行开始粘贴
    
    ' 获取Staff表最后一行数据
    lastRow = wsStaff.Cells(wsStaff.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历每个员工
    For i = 1 To lastRow
        ' 按指定次数重复复制
        For j = 1 To repeatTimes
            wsTemplate.Cells(targetRow, "A").Value = wsStaff.Cells(i, "A").Value
            targetRow = targetRow + 1 ' 下移一行准备下一次粘贴
        Next j
    Next i
    
    MsgBox "模板生成完成！"
End Sub

代码说明： #

• 效率优化：只遍历Staff表中有数据的行，用直接赋值代替Copy/PasteSpecial，运行速度更快。
• 通用性：自动从关键字中提取数字，支持"3 Week"、"10 Week"等任意周数的需求，不用硬编码判断每个关键字。
• 逻辑清晰：先清空模板表，再逐行处理员工，动态更新粘贴位置，避免数据覆盖。
• 语法正确：修复了原代码的嵌套If、Exit For等语法错误。

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