2017-04-19 77 views
0

我一直在嘗試這個小時,並沒有得到任何地方。我正在使用下面的代碼基於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 

我從Google上借了幾個小時。它創建工作表,但它們是空白的。

請幫忙!

+1

我發佈了一個答案,認爲你的'Resume'是一個'Resume Next',然後意識到它不是。所以我嘗試了你的代碼,除了在'Range(「F2:」)''中多餘的':',你的代碼工作。 (我不喜歡**的方式**它的工作原理,因爲'Select'語句應儘可能避免,但這並不會改變它實際上工作的事實。) – YowE3K

+0

同意@YowE3K - 它可以很容易地被'使用Sheets(cell.Value)'而不是'Sheets(cell.Value).Select'和'On Error GoTo CreateSheet'不必在循環內重複,因爲它沒有被重置爲'On Error GoTo 0 '隨時隨地。 – Jeeped

回答

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 
+0

這對副本的來源是很好的,但是OP想要動態地'添加一個新的工作表,如果F列中的名字不存在*'。我以前用With語句創建了新的目標工作表,但我沒有看到它在這裏如何處理。 – Jeeped

1

在我的意見,我說,這將是很容易切換到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