excel創建新工作表如果爲true

Question

我有以下問題：我有5000行和50列的excel表。我需要複製和粘貼表單並將第一個表中的行中的特定單元格的值導出到此表單中，但如果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