Delete all rows after copying in new sheet by vba

m_vishal_c

Board Regular
Joined
Dec 7, 2016
Messages
209
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
HI i need to delete all rows after copying in new sheet.

I am using below code

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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Code:
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]
 
Upvote 0
Code:
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
 
Upvote 0
What is sheet1? It did not show up in your original post.
 
Upvote 0
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

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
 
Upvote 0
Try
Code:
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
 
Upvote 0
Try
Code:
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
 
Upvote 0
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

 
Upvote 0
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
Code:
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

Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,254
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top