You are here:

Excel/Insert sheet and copy data


Hi Gulshan,

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:

Sub CreateSheet()
   With ActiveWorkbook
       .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sheet2"
   End With
End Sub

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.

Dear Natalie,

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.

Sub pk99rws()

Application.ScreenUpdating = False
rcnt = WorksheetFunction.CountA(Range("A:A"))
actcll = 9
Do While actcll <= rcnt
Range("A" & actcll).Select
With Selection.Interior
      .Color = 65535
End With
actcll = actcll + 100
Range("A:A").AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
Range("A:A").SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")
End Sub

Hope this helps.

Dear Natalie,

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.

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts




I can answer questions related to the following topics: 1. MS Excel - Creating and Linking Formulae, Running Pivot Tables, Vlookup etc. 2. Macros / VBA - Creating Macros to do specific jobs. Importing / Exporting / Validating Data in excel through Macros.


I've been working on excel for over 10 years and on VBA macros for over 3 years now.

Bachelor of Commerce, Chartered Accountant from The Institute of Chartered Accountants of India

©2017 All rights reserved.

[an error occurred while processing this directive]