0

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

pnuts
  • 58,317
  • 11
  • 87
  • 139
mauek unak
  • 702
  • 2
  • 11
  • 28
  • 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 Apr 10 '13 at 22:32
  • 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 Apr 10 '13 at 22:38
  • 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 Apr 10 '13 at 22:43

1 Answers1

0
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
Denise Skidmore
  • 2,286
  • 22
  • 51
  • well, it renamed my second sheet to "isometry" and i get VBA run-time error 9 "subscript out of range" on row Sheets("template").Copy After:=Sheets(Sheets.Count) – mauek unak Apr 10 '13 at 22:54
  • I got a little help from here: http://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists – Denise Skidmore Apr 10 '13 at 22:58
  • Do you have a sheet named "template"? – Denise Skidmore Apr 10 '13 at 22:59
  • yes, second sheet, which i want to use as template for all newly created sheets is called "template", that's why i get this error i think ? – mauek unak Apr 10 '13 at 23:02
  • for some reason i still get same message, and "worksheet exists" in immediate window. line Sheets(isometry).Cells(33, 2) = Sheet1.Cells(x, 4) subscript out of range – mauek unak Apr 10 '13 at 23:22
  • Sheet1 perhaps is the issue then? Use the debugger, find the value of Sheets(isometry), Sheets(isometry).Cells(33, 2), Sheet1 and Sheet1.Cells(x, 4). One of them will be an error if the line produces an error. – Denise Skidmore Apr 11 '13 at 13:48
  • yes, both values are correct and same - value from D2 cell on Sheet1 Sheets(isometry) = D2 Sheets(isometry).Cells(33, 2) = not created, code stops before it is even created – mauek unak Apr 11 '13 at 17:56
  • to me it looks like new sheet is not even created, that's why i get these errors - subscript out of range – mauek unak Apr 11 '13 at 18:21
  • Add a debug.print above Sheets("template").Copy After:=Sheets(Sheets.Count). See if that line is ever getting run. You say you are getting "Worksheet Exists!" printing out. does that happen every time we go through the loop and find 07 or just sometimes? – Denise Skidmore Apr 11 '13 at 19:15
  • i added "Debug.Print" to code, and now it doesn't do anything at all. even no message in immediate window. without "Debug.Print" it stops without creating any new sheet or copying any data – mauek unak Apr 11 '13 at 19:58
  • There ya go. Sorry I didn't have time to test it the first time I posted. – Denise Skidmore Apr 11 '13 at 21:38