# Excel Macros - Splitting of the ROW based on the Cell Value (divided by the number)

• ### Question

• Hi,

I am wondering if you can help me with the creation of Excel Macro? I need a macro to create extra rows based on the value of the cell divided by 1000. In addition, all information from the source row will need to be copied across newly created rows

Number 3000 from the S1 cell, will have to be divided by 1000. The quotient of the formula will be equal to the amount in a newly created ROWs (3000/1000=3). At the time, source ROW will change information/value in S1 cell to 1000.

In the case, when cell S1 will contains not full number, e.g 3560, the macro will split information into 4 rows, as per below:

BEFORE:

 POP 999 1234 ABC 1000 AABBCC QOH EA 300 0 3560 X 998 AUFNAHME

AFTER:

 POP 999 1234 ABC 1000 AABBCC QOH EA 300 0 1000 X 998 AUFNAHME POP 999 1234 ABC 1000 AABBCC QOH EA 300 0 1000 X 998 AUFNAHME POP 999 1234 ABC 1000 AABBCC QOH EA 300 0 1000 X 998 AUFNAHME POP 999 1234 ABC 1000 AABBCC QOH EA 300 0 560 X 998 AUFNAHME

*Highlighted in yellow colour are source ROWs.

The amount of the columns in the example is equal to the amount of the column in my document, that I am currently working on.

Thanks for the help in advance.

Tuesday, July 4, 2017 8:54 AM

### All replies

• Hi Aloysius Mahesh,
You need get count of the rows need to be added and then add new rows, you could use Range.Insert to add rows in worksheet.
Here is the example.
Sub CopyToDown()
Dim sRng As Range
Set sRng = Selection.EntireRow 'the source row
amount = sRng.Range("S1") 'the value in S column of this row
rcount = WorksheetFunction.RoundUp(amount / 1000, 0) - 1 'rows count need to be added
If rcount > 0 Then
sRng.Range("S1") = 1000
For i = 1 To rcount
sRng.Copy
sRng.Offset(i, 0).Insert
sRng.Offset(i, 0).PasteSpecial xlPasteAll
If i = rcount Then
modNum = amount Mod 5
If modNum > 0 Then
sRng.Offset(i, 0).Range("S1") = modNum
Else
sRng.Offset(i, 0).Range("S1") = 1000
End If
Else
sRng.Offset(i, 0).Range("S1") = 1000
End If
Next i
End If
Application.CutCopyMode = False
End Sub
Best Regards,
Terry
Wednesday, July 5, 2017 7:10 AM
• Hi Hubert_Zarod,