Excel VBA跨工作表复制指定信息失败：仅创建工作表未复制内容

原代码存在的核心问题 #

• 工作表名称拼写错误：代码中出现Worksheets("Taks List")，正确名称应为Worksheets("Task List")，拼写错误导致程序找不到目标工作表，无法完成粘贴操作。
• 循环未推进单元格：原Do Until循环中没有移动当前单元格的逻辑，程序会一直停留在C3单元格，无法遍历后续行的内容。
• 冗余代码：ActiveCell.FormulaR1C1 = "Daily"属于多余操作，已经通过判断确认当前单元格值为"Daily"，重复赋值毫无意义。
• 依赖Select/Activate：这种写法不仅运行效率低，还容易因工作表切换引发错误，应该直接引用单元格对象操作。
• 粘贴方法不规范：直接使用.Paste易出错，建议用更可靠的赋值或PasteSpecial方法。

修正后的代码 #

Private Sub PopulateTaskList()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim i As Integer
    Dim lastRow As Long
    Dim targetRow As Integer
    
    ' 检查"Task List"是否存在，不存在则创建
    Set wsTarget = Nothing
    On Error Resume Next
    Set wsTarget = ThisWorkbook.Worksheets("Task List")
    On Error GoTo 0
    
    If wsTarget Is Nothing Then
        Set wsTarget = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsTarget.Name = "Task List"
        ' 可按需添加表头
        wsTarget.Range("A1:D1").Value = Array("列A内容", "列C内容", "列B内容", "列D内容")
    End If
    
    ' 设置源工作表
    Set wsSource = ThisWorkbook.Worksheets("MSS")
    ' 获取C列最后一行行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    targetRow = 2 ' 从第2行开始插入数据
    
    ' 遍历C列从第3行开始的所有数据
    For i = 3 To lastRow
        If wsSource.Cells(i, "C").Value = "Daily" Then
            ' 插入新行
            wsTarget.Rows(targetRow).EntireRow.Insert
            ' 直接赋值替代复制粘贴，效率更高
            wsTarget.Cells(targetRow, "A").Value = wsSource.Cells(i, "A").Value
            wsTarget.Cells(targetRow, "B").Value = wsSource.Cells(i, "C").Value
            wsTarget.Cells(targetRow, "C").Value = wsSource.Cells(i, "B").Value
            wsTarget.Cells(targetRow, "D").Value = wsSource.Cells(i, "D").Value
            targetRow = targetRow + 1 ' 目标行下移，准备插入下一条数据
        End If
    Next i
End Sub

修正说明 #

1. 直接通过工作表对象引用单元格，避免激活/选择操作，提升代码稳定性和运行效率。
2. 先获取源数据的最后一行，用For循环替代Do Until，逻辑更清晰，彻底避免死循环。
3. 用单元格直接赋值替代复制粘贴，减少内存占用，运行更快。
4. 优化工作表存在性检查逻辑，代码更健壮。

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