0
votes

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

1
Not what you asked about, but you'll find things much faster if you avoid Worksheets("Sheet1").Activate and ActiveSheet references. Use objects and names whenever possible. - Denise Skidmore
during first iteration, if conditions are met, you will try to change sheet name into nothing. Move isometry = sheet1.cells(x+1,4) up or set some name before you start loop. What else do you need? Where do you have any error? To add a new sheet at the end use this simple line Sheets.Add After:=Sheets(Sheets.Count) - Kazimierz Jawor
on my first sheet, values in (x,1) and (x+1,1) are the same and code is trying to create new sheet with name of existing sheet. what i want is, if the x=x+1 or x=x-1 then add cells from that row to existing sheet and don't create new one ... - mauek unak

1 Answers

0
votes
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