Question

我已经尝试了几个小时而且没有在哪里。我使用下面的代码根据F列中的值创建新的工作表。代码创建工作表，然后将信息复制并粘贴到原始工作表中，而不是新工作表。代码如下。

Sub RunMe()
For Each cell In Range(Range("F2:"), Range("F" & Rows.Count).End(xlUp))
    cell.EntireRow.Copy
    On Error GoTo CreateSheet
    Sheets(cell.Value).Select
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Next cell

Application.CutCopyMode = False
Exit Sub

CreateSheet:
Worksheets.Add.Name = cell.Value
Resume

End Sub

我从谷歌上搜索了几个小时。它创建了工作表，但它们是空白的。

请帮忙！

Answer 1

这将有助于定义源和目标工作表。以下是我通常会做的事情：

Dim source_worksheet As Worksheet
Dim target_worksheet As Worksheet

    Set source_worksheet = ActiveWorkbook.Worksheets(" whatever sheet column F is in ex: Sheet1")

    Set target_worksheet = ActiveWorkbook.Worksheets(" whatever the new worksheet name is ex: Sheet5")

    source_worksheet.Copy After:=target_worksheet

Answer 2

在我的评论中，我已经声明可以轻松切换到定义父工作表的With ... End With，而.Select不依赖于ActiveSheet属性。

OPTION EXPLICIT

Sub RunMe()

    dim cell as range
    On Error GoTo CreateSheet

    with worksheets(range("F2").parent.name)    '<~~ name this worksheet PROPERLY!!
        For Each cell In .Range(.cells(2, "F"), .cells(.rows.count, "F").End(xlUp))
            cell.EntireRow.Copy
            with workSheets(cell.Value)
                .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
            end with
        Next cell
    end with

    Application.CutCopyMode = False
    Exit Sub

CreateSheet:
    Worksheets.Add.Name = cell.Value
    Resume

End Sub

FWIW，这是我的版本'如果名称不存在则添加新工作表'流程 - Create a new sheet for each unique agent and move all data to each sheet。

根据值

2 个答案: