Excel/Insert sheet and copy data
The code that you supplied (Sub pk99rws) works fantastic, thank you once again for this.
I thought I might go a little further and automate it even more, but I am having some problems.
At the moment I manually add “sheet2”.
What I would like to do is add it automatically with this code:
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sheet2"
This works, but then fails later I think because the code is not working in the active sheet.
If this worked I would then like to delete the data in the original sheet from “row 8” down, leaving the header data in place, then copy the filtered data in Sheet 2 into the original sheet from row 8.
I hope this makes sense.
Thank you for your valued help.
QUESTION: Hi Gulshan,
Thanks for taking a look at the code.
The code is meant to start at row 9 and delete 99 rows and then miss 1 row and so on. If I had a numbers like 1 2 3.... to 100 and 101 102 103.... to 200 and 201 202 203 .... to 300 and so on all the way to approx 900,000, I would only like to keep 1, 100, 200, 300 and so on. I just want to thin the data out.
Thanks again for your time and help.
ANSWER: Dear Natalie,
I tried a few other macro approaches, but the performance is still slow.
I've done more research and looks like any macro where the number of rows to be deleted is more than 1000 rows will cause your system to slow down and hang. In your case, its 900000 rows, which is much higher.
I have one alternative suggestion, instead of trying to delete the 99 rows, why don't you take every 100th row and filter them or copy them to a new sheet and work with them.
That way, you have to handle only about 9000 rows instead of the current approx 890000 rows.
Please let me know if this is fine and I can find a macro to do that job for you.
---------- FOLLOW-UP ----------
I would appreciate you trying your way, it sounds like a better approach then my way.
Please try using the below code. This will first identify every 100th record with a different color, then filter those identified records and copy them to another sheet (Sheet2).
Please see if this serves your purpose.
Application.ScreenUpdating = False
rcnt = WorksheetFunction.CountA(Range("A:A"))
actcll = 9
Do While actcll <= rcnt
Range("A" & actcll).Select
.Color = 65535
actcll = actcll + 100
Range("A:A").AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
Hope this helps.
This is probably failing later because you already inserted a Sheet2.
Try this:- instead of giving sheet name as Sheet2 in your macro, try giving your own sheet name and see if the code works.
If you have to run it multiple times, you'll need to delete the existing sheet.
Please let me know if this works.