値に基づいて新しいワークシートを作成

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

は、私はActiveSheetプロパティに頼らずに.Select親ワークシートを定義するWith ... End Withに切り替えるのは簡単だろうと述べました。

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を。