Excel创建新的表，如果为真

Question

i have following problem : i have excel sheet with 5000 rows and 50 columns. i need to copy and paste sheet and export values from specific cells in row in first sheet to this sheet, but if value in B1 and B2 is the same, then don't create another sheet, but copy it to same sheet under first row. i added condition "07" because i don't want excel to create 5000 sheets in one process. so far i have this :

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

i know my "code" is very simple and isn't perfect, I am starting with VBA. can someone advice how to complete it, i guess it's almost done but i am missing string for "new" sheet also, now i get error saying i can't have 2 sheets with same name, of course. thanks

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