Worksheet that lists a person's name

I have a worksheet that lists a person's name (column A; many duplicate names are in this column) with associated data (columns B through G). I have code below that takes this list of a ~ 1000 rows and then:

• Copies and pastes each row three times (to create four identical rows for each entry).

• Loops through the now ~4000 rows and creates a new worksheet for each person. As there are many duplicate names in column A this only creates a handful of new worksheets.

The thing is, it runs but runs quite slowly (and I receive the Excel not responding warning at times). Is there anything to clean this up to make it more efficient? And after this I run another macro to save the new worksheets to a new workbook. Would it be faster to do that with code here?

```
Sub Split_Data()

Const NameCol = "A"
Const HeaderRow = 1
Const FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim LastRow As Long
Dim TrgRow As Long
Dim person As String
Dim lRow As Long
Dim RepeatFactor As Variant

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Copy each row and paste three times
lRow = 2
Do While (Cells(lRow, "B") <> "")
RepeatFactor = 4

Range(Cells(lRow, "A"), Cells(lRow, "G")).Copy
Range(Cells(lRow + 1, "A"), Cells(lRow + RepeatFactor - 1, "G")).Select

Selection.Insert Shift:=xlDown
lRow = lRow + RepeatFactor - 1
lRow = lRow + 1
Loop

Set SrcSheet = ActiveSheet
LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To LastRow
person = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error Resume Next
Set TrgSheet = Worksheets(person)
On Error GoTo 0
If TrgSheet Is Nothing Then
Set TrgSheet = Worksheets.Add(After:=Worksheet

Here are my thoughts ( I'm using a tablet and so cannot test my suggestions). You are already turning off screen updating and calculations which is good.

• Avoid using Select where possible - there are plenty of examples of this.

• The Insert in your code is probably a very slow process because Excel does a lot of work. Why not simply copy the entire data in the columns you want and then paste four times onto another sheet? No need for the Insert or the 1,000 copy & pastes.

• Testing each row for the person's name to see if a worksheet exists and then copying just that row can also be changed. Why not sort the data by name, then run down the data keeping track of start row of current name and looking to see when the name changes? Then you copy the data from the start row up to the row before the current one. That way you could do just one copy & paste per name into the named worksheet.

StackExchange Code Review Q#150707, answer score: 4