Copy data into different named multiple sheets

Question

Dears,

I am a beginner and tried to prepare the macro that enables firstly delete rows based on condition, than create new sheets based on criteria from the first main sheet and add data from the first main sheet into multiple named sheets.

deletes rows based on condition (RUNs OK)
creates new sheets based on criteria from the first main sheet (RUNs OK)
adds data from the first main sheet (constant range I4:I6) into multiple named sheets to A1:A3 in all of them (being created by this macro). Unfortunately I do not know how to do that :-(

Could you possibly help me, please?

Private Sub CommandButton1_Click()

   Dim lastrow As Long, x As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = lastrow To 1 Step -1
        If UCase(Cells(x, 3).Value) = "0" And _
        UCase(Cells(x, 6).Value) = "0" Then
        Rows(x).Delete
        End If
    Next

    lastcell = ThisWorkbook.Worksheets("Obratova predvaha").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastcell

    With ThisWorkbook

    newname = ThisWorkbook.Worksheets("Obratova predvaha").Cells(i, 1).Value

    .Sheets.Add after:=.Sheets(.Sheets.Count)

    ActiveSheet.Name = newname

    End With

    Next

    ThisWorkbook.Worksheets("Obratova predvaha").Activate
    ThisWorkbook.Worksheets("Obratova predvaha").Cells(1, 1).Select

End Sub

DisplayName DisplayName · Accepted Answer · 2018-11-25T14:06:16

not very sure about your description, but you may try this:

edited to add a sheet variable and prevent any (possible?) time lapse misbehavior between new sheet adding and writing to it by implicitly assuming it as ActiveSheet:

Option Explicit

Private Sub CommandButton1_Click()
    Dim lastrow As Long, i As Long
    Dim newSheet As Worksheet

    With Worksheets("Obratova predvaha")
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = lastrow To 1 Step -1
            If UCase(.Cells(i, 3).Value) = "0" And UCase(.Cells(i, 6).Value) = "0" Then .Rows(i).Delete
        Next

        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lastrow
            Set newSheet = Sheets.Add(after:=Sheets(Sheets.Count)) ' add a new sheet and hold its reference in newSheet  variable
            newSheet.Range("A1:A3").Value = .Range("I4:I6").Value ' copy referenced sheet I4:I6 values into newly added sheet cells A1:A3
            newSheet.Name = .Cells(i, 1).Value ' change the name of newly added sheet
        Next
    End With
End Sub

Copy data into different named multiple sheets

1 Answers