excel создать новый лист, если true

Question

У меня есть следующая проблема: у меня есть лист excel с 5000 строк и 50 столбцов. мне нужно копировать и вставлять листы и экспортировать значения из определенных ячеек в строке в первом листе на этот лист, но если значение в B1 и B2 одинаково, тогда не создавайте другой лист, а скопируйте его на тот же лист в первой строке , Я добавил условие «07», потому что я не хочу, чтобы excel создавал 5000 листов в одном процессе. до сих пор у меня есть это:

Sub Button1_Click() 
Dim newsheetname As String 
Dim isometry As String 
Application.ScreenUpdating = False 
Worksheets("Sheet1").Activate 
x = 2 

Do While Cells(x, 4) <> "" 

If Cells(x, 1) = "07" Then 
Sheets(Sheets.Count).Select 
Cells(33, 2) = Sheet1.Cells(x, 4)  
Cells(33, 28) = Sheet1.Cells(x, 32) 
End If 

If Cells(x, 4) <> Cells(x + 1, 4) Then 
Sheets("template").Copy After:=Sheets(Sheets.Count) 
ActiveSheet.Name = isometry 
End If 

isometry = Sheet1.Cells(x + 1, 4) 
x = x + 1 
Worksheets("Sheet1").Activate 

Loop 

End Sub 

я знаю, что мой «код» очень проста и не совершенна, я начинаю с VBA. может кто-то посоветовать, как его завершить, я думаю, что это почти сделано, но я пропускаю строку для «нового» листка также, теперь я получаю сообщение об ошибке, я не могу иметь 2 листа с таким же именем, конечно. благодаря

Answer 1

Sub Button1_Click() 
    Dim newsheetname As String 
    Dim isometry As String 
    Dim newSheet As Worksheet 
    Application.ScreenUpdating = False 
    x = 2 

    'Go down the Sheet1 until we find a blank cell in column 4 
    Do While Worksheets("Sheet1").Cells(x, 4) <> "" 

     'If we find the value 07, copy two values to the isometry sheet 
     If Sheet1.Cells(x, 1) = "07" Then 

      isometry = Sheet1.Cells(x, 4) 

      'create the sheet if it does not exist 
      If Not SheetExists(isometry) Then 
       Sheets("template").Copy After:=Sheets(Sheets.Count) 
       Sheets(Sheets.Count).Name = isometry 
      End If 

      'Copy our data 
      Sheets(isometry).Cells(33, 2) = Sheet1.Cells(x, 4) 
      Sheets(isometry).Cells(33, 28) = Sheet1.Cells(x, 32) 
     End If 

     'Move on to the next row 
     x = x + 1 

    Loop 
    Application.ScreenUpdating = True 
End Sub 

Function SheetExists(isometry) As Boolean 
    Dim exists As Boolean 
    exists = False 
    For Each Sheet In Worksheets 
     If Sheet.Name = isometry Then 
      exists = True 
      Exit For 
     End If 
    Next 
    SheetExists = exists 
End Function