基于值创build新的工作表

我一直在尝试这个小时，并没有得到任何地方。 我正在使用下面的代码来创build基于列F中的值的新工作表。该代码创build工作表，但然后复制并粘贴到原始工作表，而不是新的工作表。 代码如下。

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 

我从几个小时的网上借了。 它创build表单，但它们是空白的。

请帮忙！

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将很容易定义父级工作表，而不依赖于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，这是我的版本'添加一个新的工作表，如果名称不存在'的过程 – 为每个独特的代理创build一个新的工作表，并将所有数据移动到每个工作表 。