2016-11-02 3 views
0

Привет Я пытаюсь создать копию рабочего листа в книге для каждой записи в диапазоне, а затем переименуйте рабочий лист на основе значения текущей ячейки в этом диапазоне. Он работал раньше, но теперь он не называет новые листы. Если я сделаю пустые листы, они назовут их, однако, если я скопирую рабочий лист, он не назовет рабочий лист должным образом. Я также пытаюсь установить значение C1 на каждом листе на значение, которое из диапазона. Ниже приведен мой код:Создайте копию рабочего листа и назовите его на основе списка

Sub CreateSEMSheets() 
    On Error GoTo GetOut 


    Dim MyCell As Range, MyRange As Range 

    Set MyRange = Sheets("Strategic End Market Data").Range("SEMListGenerated") 

    For Each MyCell In MyRange 
    If MyCell.Value = "" Then GoTo GetOut 

     Sheets("StrategicMktPlan").Copy After:=Sheets(Sheets.Count) 
     Sheets(Sheets.Count).Name = "SMP - " & MyCell.Value 
     Sheets(Sheets.Count).Range("C1").Value = MyCell.Value 
    Next MyCell 

GetOut: 

End Sub 

Пожалуйста, помогите !!! Заранее спасибо.

Редактировать: Я выяснил, почему он не работает - был скрытый лист, который был последним листом в книге, и он снова и снова переименовывал его. Любая идея, как предотвратить это?

ответ

2

После метода Copy() из рабочего листа объекта вновь созданный рабочий лист является активным один:

For Each MyCell In MyRange 
    If MyCell.Value = "" Then GoTo GetOut 

    Sheets("StrategicMktPlan").Copy After:=Sheets(Sheets.Count) 
    With ActiveSheet 
     .Name = "SMP - " & MyCell.Value 
     .Range("C1").Value = MyCell.Value 
    End With 
Next MyCell 
+0

Удаляются шахтный и проголосовали эти один. –

+0

Спасибо @JReid – user3598756

+0

Я попытался реализовать это, но по какой-то причине он все равно останавливается раньше - он создает один лист, переименовывает его и копирует значение в C1, но после этого он копирует исходный лист и завершает работу, хотя есть еще несколько элементы, оставшиеся в списке. Нет никаких скрытых листов или чего-то подобного, чтобы повесить его, поэтому я нахожусь в конце ... –

0

За ваши изменения, вы можете использовать это:

Sub VisibleSheetsCount() 
'UpdatebyKutoolsforExcel20150909 
' https://www.extendoffice.com/documents/excel/3187-excel-count-visible-sheets.html 
    Dim xSht As Variant 
    Dim I As Long 
    For Each xSht In ActiveWorkbook.Sheets 
        If xSht.Visible Then I = I + 1 
    Next 
    MsgBox I & " sheets are visible", , "Kutools for Excel" 
End Sub 

Затем сделайте .Copy(After:=Sheets(I)) я думаю, будет работать.

Смежные вопросы