VBA добавления рабочих листов из списка

Question

Я все еще очень новичок в VBA, и у меня возникли проблемы с получением кода для работы. У меня есть один подраздел, где я хочу создавать рабочие листы, основанные на списке имен на листе с именем AllCities. Список названий городов начинается в ячейке A2. Таблицы должны быть названы после значения ячейки в списке, и список должен быть обновлен. Код сейчас работает, но он не добавляет новые листы, если я добавляю в список имен. Мой второй юг должен удалить любые рабочие листы, которые не соответствуют городу в списке. Мой элемент delete просто удаляет все рабочие листы прямо сейчас.

Вставка листа Код:

Sub insertSheets() 

Dim myCell As Range 
Dim MyRange As Range 
Dim MyRange2 As Range 

Set MyRange = Sheets("AllCities").Range("A2") 
Set MyRange2 = Range(MyRange, MyRange.End(xlDown)) 

For Each myCell In MyRange2 
    Sheets.Add After:=Sheets(Sheets.Count) 
    Sheets(Sheets.Count).Name = myCell.Value 

Next myCell 

End Sub 

Удалить лист Код:

Sub deleteSheets() 

Dim wks As Worksheet 
Dim MyRange As Range 
Dim myCell As Range 

Set wks = Sheets("AllCities") 

With wks 
    Set MyRange = Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) 
End With 

On Error Resume Next 
Application.DisplayAlerts = False 
For Each myCell In MyRange 
    Sheets(myCell.Value).Delete 
Next myCell 
Application.DisplayAlerts = True 
On Error GoTo 0 

End Sub 

Спасибо за любую помощь, которую вы имеете!

Answer 1

Вы пытаетесь использовать два разных метода (которые принесут разные результаты), чтобы найти последнюю ячейку в диапазоне.

В вашей insertSheets процедуры, вы используете:

Set MyRange2 = Range(MyRange, MyRange.End(xlDown)) 

Это тот же эффект, удерживая Ctrl и нажав кнопку со стрелкой вниз, которая найдет последнюю ячейку, прежде чем пустая ячейка присутствует.

В вашей deleteSheets процедуры используется:

Set MyRange = Range("A1", .Cells(.Rows.Count, "A").End(xlUp)) 

Это имеет различный эффект от того, как вы искали в insertSheets процедуры, как она начинается с нижней частью листа, чтобы найти истинную последнюю ячейку в диапазоне ,

Я предлагаю о внесении изменений вашей insertSheets процедуры:

Sub insertSheets() 

Dim myCell As Range 
Dim MyRange As Range 
Dim MyRange2 As Range 

With Sheets("AllCities") 
    Set MyRange = .Range("A2") 
    Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp) 
End With 

For Each myCell In MyRange2 
    If Not myCell.Value = vbNullString Then 
     Sheets.Add After:=Sheets(Sheets.Count) 
     Sheets(Sheets.Count).Name = myCell.Value 
    End If 
Next myCell 

End Sub 

Это будет также проверить, что клетка не является пустой и, следовательно, предотвратить Excel от метания ошибки, потому что вы пытаетесь переименовать новый рабочий лист, чтобы не имеющие никакого имени.