Delete all rows after copying in new sheet by vba

[m_vishal_c]

HI i need to delete all rows after copying in new sheet.

I am using below code

last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).RowSet rng = Sheets(sht).Range("A1:F" & last)
Set rng1 = Worksheets("Need to be removed 0").Range("B2:B4")


'Sheets(sht).Range("F1:F" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L1"), Unique:=True ''' THIS IS FOR ENTIRE RANGE NOT FOR PERTICULAR VALUE, Macro will create all values's extra sheet




Dim sCriteria As String




For Each x In rng1 


sCriteria = "*" & x.Value & "*"
With rng
    '.AutoFilter Field:=1, Criteria1:="=(x.value)*", Operator:=xlFilterValues
     .AutoFilter Field:=3, Criteria1:=sCriteria, Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
    ActiveSheet.Paste
End With
Next x


' Turn off filter
Sheets(sht).AutoFilterMode = False

Heaps thanks

 

[yky]

With rng
    '.AutoFilter Field:=1, Criteria1:="=(x.value)*", Operator:=xlFilterValues
     .AutoFilter Field:=3, Criteria1:=sCriteria, Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
    ActiveSheet.Paste
End With
Next x

[COLOR=#ff0000]rng1.EntireRow.Delete <- add this line[/COLOR]

 

[m_vishal_c]

With rng
    '.AutoFilter Field:=1, Criteria1:="=(x.value)*", Operator:=xlFilterValues
     .AutoFilter Field:=3, Criteria1:=sCriteria, Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
    ActiveSheet.Paste
End With
Next x

[COLOR=#ff0000]rng1.EntireRow.Delete <- add this line[/COLOR]

hi. Sorry to say that. "rng1.EntireRow.Delete <- add this line" this code does not work. data is still there in sheet1. Please update me. thanks

 

[yky]

What is sheet1? It did not show up in your original post.

 

[m_vishal_c]

What is sheet1? It did not show up in your original post.

hi Sorry, it was my mistake. i forgot to copy 1 line above.

Now i am copying entire code

Application.ScreenUpdating = False
Dim x As Range
Dim rng, rng1 As Range
Dim last As Long
Dim sht As String






'specify sheet name in which the data is stored
sht = "Sheet1"


'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:F" & last)
Set rng1 = Worksheets("Need to be removed 0").Range("B2:B4")


'Sheets(sht).Range("F1:F" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L1"), Unique:=True ''' THIS IS FOR ENTIRE RANGE NOT FOR PERTICULAR VALUE, Macro will create all values's extra sheet




Dim sCriteria As String




For Each x In rng1 'Range(Sheets("Need to be removed 0").B2)   '([L2], Cells(Rows.Count, "L").End(xlUp)) ' K column has some specific value in excel so macro will create only those value's extra sheet
sCriteria = "*" & x.Value & "*"
With rng
    '.AutoFilter Field:=1, Criteria1:="=(x.value)*", Operator:=xlFilterValues
     .AutoFilter Field:=3, Criteria1:=sCriteria, Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Copy
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
    ActiveSheet.Paste
End With
Next x
'rng1.EntireRow.Delete
' Turn off filter
Sheets(sht).AutoFilterMode = False


With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

i tried rng1.EntireRow.Delete but it deletes rows from newly created sheet but not from Sheet1. I want to be deleted from Sheet1.

Thanks

 

[Fluff]

Try

With Rng
   '.AutoFilter Field:=1, Criteria1:="=(x.value)*", Operator:=xlFilterValues
   .AutoFilter Field:=3, Criteria1:=sCriteria, Operator:=xlFilterValues
   .SpecialCells(xlCellTypeVisible).Copy
   Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
   ActiveSheet.Paste
  [COLOR=#0000ff] .SpecialCells(xlVisible).EntireRow.Delete[/COLOR]
End With

 

[m_vishal_c]

Try

With Rng
   '.AutoFilter Field:=1, Criteria1:="=(x.value)*", Operator:=xlFilterValues
   .AutoFilter Field:=3, Criteria1:=sCriteria, Operator:=xlFilterValues
   .SpecialCells(xlCellTypeVisible).Copy
   Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
   ActiveSheet.Paste
  [COLOR=#0000ff] .SpecialCells(xlVisible).EntireRow.Delete[/COLOR]
End With

hi, Thanks for replying, this code works but it deletes header in Sheet1 and other sheets too(from automated created sheet)
Please guide me.
thanks

 

[yky]

Can't see why the code would delete rows in other sheets. Maybe it deletes from rng so in subsequent loop, the deleted rows, of course, are not copied. If you just want to delete the source, try:

rng.EntireRow.Delete <- add this line

 

[m_vishal_c]

Can't see why the code would delete rows in other sheets. Maybe it deletes from rng so in subsequent loop, the deleted rows, of course, are not copied. If you just want to delete the source, try:

rng.EntireRow.Delete <- add this line

that above code delete header in source file(Sheet1) and from other sheets too. if i use rng.EntireRow.Delete then it deletes
if i add this above line here then it copied to other sheet but delete header from source and other sheets too, and does not delete source data after copying to other sheet

For Each x In Sheets("Sheet1").Range([L2], Cells(Rows.Count, "L").End(xlUp)) 'to split all of them
    With rng
        .AutoFilter
        .AutoFilter Field:=6, Criteria1:=x.Value
        .SpecialCells(xlCellTypeVisible).Copy
        On Error Resume Next
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
        ActiveSheet.Paste
    End With
[COLOR=#ff0000]    rng.EntireRow.Delete[/COLOR]
Next x

and if i copy that above line to here then it removes header from Source so only some rows copied to other sheet and other sheets also without header

For Each x In Sheets("Sheet1").Range([L2], Cells(Rows.Count, "L").End(xlUp)) 'to split all of them
    With rng
        .AutoFilter
        .AutoFilter Field:=6, Criteria1:=x.Value
        .SpecialCells(xlCellTypeVisible).Copy
        On Error Resume Next
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
        ActiveSheet.Paste
[COLOR=#ff0000]        rng.EntireRow.Delete[/COLOR]
    End With
Next x

hope i can explain better . if you need more information then please let me know.

thanks for your time

 

[yky]

Look at my first reply. That line of code should be outside the For ... Next loop.
My understanding is that you want to delete the source, rng. If not, please clarify.