wliang - - Latest reply:
emily1214

- Posts
- 1
- Registration date
- Monday May 19, 2014
- Last seen
- May 19, 2014

Related:

- Split data into several rows of same data
- Excel - Split data into several rows - How-To - Excel
- Split data into multiple worksheets excel 2007 - How-To - Excel
- Excel/VBA - A macro to split data - How-To - Excel
- VB for split data ✓ - Forum - Office Software
- Split data into multiple sheets using macro ✓ - Forum - Excel

Best answer

TrowaD

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

First select the entire row you would like to see repeated.

Run the following code:

Running the code will let you input the number of times you want to see the row repeated.

In your case select the row with 100pcs in it, run the code, input 10 and you will see that your one row turned into 10 rows.

Best regards,

Trowa

First select the entire row you would like to see repeated.

Run the following code:

Sub RepeatRow() Dim iRow As Integer Dim x As Integer Dim y As Integer iRow = ActiveCell.Row x = InputBox("Number of times you want to display the selected row:") y = 1 Do Rows(iRow).Copy Selection.Insert Shift:=xlDown y = y + 1 Loop Until y = x Application.CutCopyMode = False End Sub

Running the code will let you input the number of times you want to see the row repeated.

In your case select the row with 100pcs in it, run the code, input 10 and you will see that your one row turned into 10 rows.

Best regards,

Trowa

A few words of thanks would be greatly appreciated. Add comment

3018 users have said thank you to us this month

Hi Trowa,

Thanks for your help. It works as mentioned as I am new to this VBA thing.

I have another question. I have this set of data as followed:

Part # Total Qty

A 1,000

B 200

C 100

For part A, the quantity per pallet is 500, part B is 100 and part C is 50. I wanted to have Part A to be repeated to the number of pallets based on the total quantity divided by quantity per pallet. In case for Part A, 1000 divided by 500 equals to 2, which means Part A is repeated twice. Same goes for Part B and C.

Thanks in advance for your help.

Best regards,

wliang

Thanks for your help. It works as mentioned as I am new to this VBA thing.

I have another question. I have this set of data as followed:

Part # Total Qty

A 1,000

B 200

C 100

For part A, the quantity per pallet is 500, part B is 100 and part C is 50. I wanted to have Part A to be repeated to the number of pallets based on the total quantity divided by quantity per pallet. In case for Part A, 1000 divided by 500 equals to 2, which means Part A is repeated twice. Same goes for Part B and C.

Thanks in advance for your help.

Best regards,

wliang

Hi rizvisa1,

Thanks for your reply. Yes, I have a master sheet where I list the parts and the # of units on a pallet. Basically, my master sheet is in this form:

Part No. ----- Total Qty ----- #of units per pallet

A ----- 1,000 ----- 500

B ----- 200 ----- 100

C ----- 100 ----- 50

Then, these data will be repeated in the number of rows according to the result of the division of total quantity and # of units per pallet in a new sheet. I have uploaded a sample file for your perusal at http://www.speedyshare.com/files/29107975/Packing_Exp.xls

Thank you in advance for your help.

Best regards,

wliang

Thanks for your reply. Yes, I have a master sheet where I list the parts and the # of units on a pallet. Basically, my master sheet is in this form:

Part No. ----- Total Qty ----- #of units per pallet

A ----- 1,000 ----- 500

B ----- 200 ----- 100

C ----- 100 ----- 50

Then, these data will be repeated in the number of rows according to the result of the division of total quantity and # of units per pallet in a new sheet. I have uploaded a sample file for your perusal at http://www.speedyshare.com/files/29107975/Packing_Exp.xls

Thank you in advance for your help.

Best regards,

wliang

TrowaD

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

See if this is what you were hoping for:

http://www.speedyshare.com/files/29115453/Packing_Exp.xls

Best regards,

Trowa

See if this is what you were hoping for:

http://www.speedyshare.com/files/29115453/Packing_Exp.xls

Best regards,

Trowa

Hi Trowa,

Sorry to re-open this message list again. I have tried to modify a bit of the codes you have provided to suit into the reporting format required. However, I encountered some problems.

1. Loop does not end even though rows were completely repeated.

2. Some other blanks rows were repeated as well.

I have attached the file here: http://www.speedyshare.com/files/29124147/Packfile.xls

Once again, thanks in advance for your help.

Best regards,

wliang

Sorry to re-open this message list again. I have tried to modify a bit of the codes you have provided to suit into the reporting format required. However, I encountered some problems.

1. Loop does not end even though rows were completely repeated.

2. Some other blanks rows were repeated as well.

I have attached the file here: http://www.speedyshare.com/files/29124147/Packfile.xls

Once again, thanks in advance for your help.

Best regards,

wliang

TrowaD

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

No problems for re-opening your post, only be satisfied with the desired result.

You probably get stuck on determing the last row.

Since you use column A for numbering you will have to change this codeline:

lrow = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row

into:

lrow = Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row

But perhaps you did this already and still are stuck. That's because you entered zero's (0's) in the range B15:D32. If you forgot to remove them, then do so and your problem is solved.

If they are there intentionally, then change the above codeline into:

lrow = Range("I" & Rows.Count).End(xlUp).Offset(1, 0).Row

or

lrow = Range("L" & Rows.Count).End(xlUp).Offset(1, 0).Row

Make sure you hit delete on cell I34 or L34, since there seems to be some invisible data (When you select cell I40 for example and hit End and then arrow up, you will notice you get stuck on I34).

If I have to guess, you just forgot there were zero's in that range (B15:D32). So I deleted them and adjusted the code for you. Here is your file:

http://www.speedyshare.com/files/29130743/Packfile.xls

Best regards,

Trowa

No problems for re-opening your post, only be satisfied with the desired result.

You probably get stuck on determing the last row.

Since you use column A for numbering you will have to change this codeline:

lrow = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row

into:

lrow = Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row

But perhaps you did this already and still are stuck. That's because you entered zero's (0's) in the range B15:D32. If you forgot to remove them, then do so and your problem is solved.

If they are there intentionally, then change the above codeline into:

lrow = Range("I" & Rows.Count).End(xlUp).Offset(1, 0).Row

or

lrow = Range("L" & Rows.Count).End(xlUp).Offset(1, 0).Row

Make sure you hit delete on cell I34 or L34, since there seems to be some invisible data (When you select cell I40 for example and hit End and then arrow up, you will notice you get stuck on I34).

If I have to guess, you just forgot there were zero's in that range (B15:D32). So I deleted them and adjusted the code for you. Here is your file:

http://www.speedyshare.com/files/29130743/Packfile.xls

Best regards,

Trowa

Hi Trowa,

Thanks once again for your kind help and patience in helping me with my questions.

My first question is based on the codes you provided, I have tried to modify them to include a condition where the quantity of pallet is less than zero or with decimal point. Unfortunately, the macro loops endlessly. Below is my codes and I guess I didn't get it right somewhere.

Sub RepeatRow()

Dim sRow As Integer

Dim lrow As Integer

Dim x As Integer

Dim y As Integer

sRow = Range("A8").Row

x = Cells(sRow, 6)

y = 1

If x > 1 Then

Do

x = Cells(sRow, 6)

y = 1

Do

Rows(sRow).Copy

Rows(sRow).Select

Selection.Insert Shift:=xlDown

y = y + 1

Loop Until y = x

lrow = Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row

sRow = sRow + x

Loop Until sRow = lrow

End If

Application.CutCopyMode = False

End Sub

And my second question is if the data is referenced from another sheet, is this macro still applicable? For example, data in Column B to F and Column J to L are referencing to data in Sheet1. I have tried but the macro loops endlessly. I guess it's not possible. Please correct me if I am wrong.

Once again, thank you for your help.

Best regards,

wliang

Thanks once again for your kind help and patience in helping me with my questions.

My first question is based on the codes you provided, I have tried to modify them to include a condition where the quantity of pallet is less than zero or with decimal point. Unfortunately, the macro loops endlessly. Below is my codes and I guess I didn't get it right somewhere.

Sub RepeatRow()

Dim sRow As Integer

Dim lrow As Integer

Dim x As Integer

Dim y As Integer

sRow = Range("A8").Row

x = Cells(sRow, 6)

y = 1

If x > 1 Then

Do

x = Cells(sRow, 6)

y = 1

Do

Rows(sRow).Copy

Rows(sRow).Select

Selection.Insert Shift:=xlDown

y = y + 1

Loop Until y = x

lrow = Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row

sRow = sRow + x

Loop Until sRow = lrow

End If

Application.CutCopyMode = False

End Sub

And my second question is if the data is referenced from another sheet, is this macro still applicable? For example, data in Column B to F and Column J to L are referencing to data in Sheet1. I have tried but the macro loops endlessly. I guess it's not possible. Please correct me if I am wrong.

Once again, thank you for your help.

Best regards,

wliang

TrowaD

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang

I will look into it as soon as you upload a non-zipped file.

I'm not allowed to unzip files at my working space.

quote

I have tried to modify them to include a condition where the quantity of pallet is less than zero or with decimal point.

unquote

1. What do you want to happen when the quantity of pallets is less than zero? (how is this even possible?)

2. What do you want to happen when the quantity of pallets have a decimal point?

Since you probably don't have 0.3 pallet (for example), did you consider the use of ROUNDUP function? It will change 0.3 into 1.

best regards,

Trowa

I will look into it as soon as you upload a non-zipped file.

I'm not allowed to unzip files at my working space.

quote

I have tried to modify them to include a condition where the quantity of pallet is less than zero or with decimal point.

unquote

1. What do you want to happen when the quantity of pallets is less than zero? (how is this even possible?)

2. What do you want to happen when the quantity of pallets have a decimal point?

Since you probably don't have 0.3 pallet (for example), did you consider the use of ROUNDUP function? It will change 0.3 into 1.

best regards,

Trowa

Hi Trowa,

Thanks for your response.

1. I know it's not possible to have quantity of pallets less than zero. This will only happens when our customers order a loose shipment (not full pallet quantity). When it is less than zero, the line should not be repeated and remained as it is.

2. If the quantity of pallets have a decimal point, it should be considered as 1, i.e. if 4.3 or 4.9 then it should be repeated 5 times.

Sorry for uploading a zipped file. Here is the unzipped version: http://www.speedyshare.com/files/29206764/Packfile1.xls

Again, thanks for your kind help.

Best regards,

wliang

Thanks for your response.

1. I know it's not possible to have quantity of pallets less than zero. This will only happens when our customers order a loose shipment (not full pallet quantity). When it is less than zero, the line should not be repeated and remained as it is.

2. If the quantity of pallets have a decimal point, it should be considered as 1, i.e. if 4.3 or 4.9 then it should be repeated 5 times.

Sorry for uploading a zipped file. Here is the unzipped version: http://www.speedyshare.com/files/29206764/Packfile1.xls

Again, thanks for your kind help.

Best regards,

wliang

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

#. Column I is the only row with data which isn't pulled using formula. So lRow will be determined using column I.

#. You probably noticed that copying down the formula's will change the data. So now the code first insert x number of empty rows and then fills it with values instead of formula's.

The first row of formula's will always be there, so to restore the sheet you can delete everything except the first row of data (row 8) and then drag the formula row down. If this is an action you do regularly, you can record a macro for it.

1. Quantity's less then 1 will be treated as quantity's of 1 i.e. nothing will happen to that row.

2. As suggested in previous post, the ROUNDUP function has been added to the existing formula's.

#. FYI: I added two extra testlines to see if the code works.

#. I added the lines:

Application.ScreenUpdating = False

and

Application.ScreenUpdating = True

This prevents the sheet from shifting up and down as the code is being run. If you liked that then remove these two lines.

Here is your file:

http://www.speedyshare.com/files/29224539/Packfile1.xls

Looking forward to your reply.

Best regards,

Trowa

#. Column I is the only row with data which isn't pulled using formula. So lRow will be determined using column I.

#. You probably noticed that copying down the formula's will change the data. So now the code first insert x number of empty rows and then fills it with values instead of formula's.

The first row of formula's will always be there, so to restore the sheet you can delete everything except the first row of data (row 8) and then drag the formula row down. If this is an action you do regularly, you can record a macro for it.

1. Quantity's less then 1 will be treated as quantity's of 1 i.e. nothing will happen to that row.

2. As suggested in previous post, the ROUNDUP function has been added to the existing formula's.

#. FYI: I added two extra testlines to see if the code works.

#. I added the lines:

Application.ScreenUpdating = False

and

Application.ScreenUpdating = True

This prevents the sheet from shifting up and down as the code is being run. If you liked that then remove these two lines.

Here is your file:

http://www.speedyshare.com/files/29224539/Packfile1.xls

Looking forward to your reply.

Best regards,

Trowa

Hi Trowa,

Sorry for my late response. Thanks for your help. I have went through the codes and it indeed working great!

I believe I am nearing the completion of the report. However, I still have a couple of questions that would need your advice.

1. When the rows are repeated, only data in Column A to C to be shown in the repeated rows. Column D to F should be left blank in the repeated rows.

2. Column J to L should be formularized. In this case, I believe a macro can be recorded to drag the formula from the first row. What if the numbers of rows to be formularized is different everytime, will the recorded macro still works?

3. Is it possible to delete some blank rows after the last row with data?

You can use the same file as previous one. Sorry for so many questions. Appreciate your help.

Thank you very much in advance.

Best regards,

wliang

Sorry for my late response. Thanks for your help. I have went through the codes and it indeed working great!

I believe I am nearing the completion of the report. However, I still have a couple of questions that would need your advice.

1. When the rows are repeated, only data in Column A to C to be shown in the repeated rows. Column D to F should be left blank in the repeated rows.

2. Column J to L should be formularized. In this case, I believe a macro can be recorded to drag the formula from the first row. What if the numbers of rows to be formularized is different everytime, will the recorded macro still works?

3. Is it possible to delete some blank rows after the last row with data?

You can use the same file as previous one. Sorry for so many questions. Appreciate your help.

Thank you very much in advance.

Best regards,

wliang

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

1. A codeline has been added. Check out the green comment in the code.

2. Check out the macro called DragDownFormula. This macro is dependent on the value in column J two rows below the grid. If a value remains there the macro will work fine.

3. I can't think of any reason why not.

Play around with your file. Try to create different situations that might occur. Then let me know your findings.

Here is your file:

http://www.speedyshare.com/files/29344789/Packfile2.xls

Best regards,

Trowa

1. A codeline has been added. Check out the green comment in the code.

2. Check out the macro called DragDownFormula. This macro is dependent on the value in column J two rows below the grid. If a value remains there the macro will work fine.

3. I can't think of any reason why not.

Play around with your file. Try to create different situations that might occur. Then let me know your findings.

Here is your file:

http://www.speedyshare.com/files/29344789/Packfile2.xls

Best regards,

Trowa

Hi Trowa,

Thank you very much for your help. The codes are working great! By the way, I have make some slight changes to the codes so that it suits into the reporting requirements.

Regarding my third question in the previous post where the blank rows to be deleted, I looked through some of the posts here regarding the deletion of blank rows but can only find the codes for deleting hidden rows.

I have modified some codes but it was not working as intended.

Sub DeleteRows()

Dim iRow As Long

With Application

.Calculation = xlCalculationManual

.EnableEvents = False

.ScreenUpdating = False

With ActiveSheet.UsedRange

For iRow = .Row + .Rows.Count - 1 To .Row Step -1

If Rows(iRow) = "" Then Selection.EntireRow.Delete

Next iRow

End With

.Calculation = xlCalculationAutomatic

.EnableEvents = True

.ScreenUpdating = True

End With

End Sub

Also, I have recorded a macro for blank rows deletion but it will only delete the specific rows recorded in the macro everytime although the blank rows are different.

I have attached the file for your perusal. In the file, I would like to have all the blank rows after Row 47 to be deleted but the calculation in Row 60 should remained and moved up accordingly when the blank rows are deleted.

Here is the file http://www.speedyshare.com/files/29469575/DPS_Shipment_Packing_V2.3.xls

Once again, thank you very much for your time and patience in helping me with this.

Best regards,

wliang

Thank you very much for your help. The codes are working great! By the way, I have make some slight changes to the codes so that it suits into the reporting requirements.

Regarding my third question in the previous post where the blank rows to be deleted, I looked through some of the posts here regarding the deletion of blank rows but can only find the codes for deleting hidden rows.

I have modified some codes but it was not working as intended.

Sub DeleteRows()

Dim iRow As Long

With Application

.Calculation = xlCalculationManual

.EnableEvents = False

.ScreenUpdating = False

With ActiveSheet.UsedRange

For iRow = .Row + .Rows.Count - 1 To .Row Step -1

If Rows(iRow) = "" Then Selection.EntireRow.Delete

Next iRow

End With

.Calculation = xlCalculationAutomatic

.EnableEvents = True

.ScreenUpdating = True

End With

End Sub

Also, I have recorded a macro for blank rows deletion but it will only delete the specific rows recorded in the macro everytime although the blank rows are different.

I have attached the file for your perusal. In the file, I would like to have all the blank rows after Row 47 to be deleted but the calculation in Row 60 should remained and moved up accordingly when the blank rows are deleted.

Here is the file http://www.speedyshare.com/files/29469575/DPS_Shipment_Packing_V2.3.xls

Once again, thank you very much for your time and patience in helping me with this.

Best regards,

wliang

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

As requested, I added the macro DeletingEmptyRows in the DeletingRows module.

Check and try it out:

http://www.speedyshare.com/files/29474374/DPS_Shipment_Packing_V2.3.xls

Let me know if there is more you need assistance with.

Best regards,

Trowa

As requested, I added the macro DeletingEmptyRows in the DeletingRows module.

Check and try it out:

http://www.speedyshare.com/files/29474374/DPS_Shipment_Packing_V2.3.xls

Let me know if there is more you need assistance with.

Best regards,

Trowa

Hi Trowa,

Sorry for my late response.

I worked with my colleagues to use the file and find it very helpful. And based on the assistance and guidance you provided, I am trying out some changes to make the file looks better.

Once again, thank you very much for your time, patience and guidance extended to help me build up this report.

P.S. Should I re-open this message list if I have some other questions related to this or I will need to open a new message list? Thanks in advance for your advice.

Best regards,

wliang

Sorry for my late response.

I worked with my colleagues to use the file and find it very helpful. And based on the assistance and guidance you provided, I am trying out some changes to make the file looks better.

Once again, thank you very much for your time, patience and guidance extended to help me build up this report.

P.S. Should I re-open this message list if I have some other questions related to this or I will need to open a new message list? Thanks in advance for your advice.

Best regards,

wliang

Hi Trowa,

Sorry to bother you again. I would like to insert some rows (say 4 rows) in between Row 38 and Row 40. After inserting the rows, I would like to have the formula in Row 38 to be dragged down to the blank rows.

I have referred to the codes that you have provided to me earlier and managed to insert 4 rows but the formula was not dragged down to the blank rows.

I have listed below the codes I used for your advice.

Sub LastRow()

Dim sRow As Integer

Dim lRow As Integer

Dim x As Integer

Dim y As Integer

sRow = Range("A38").Row

x = 1

y = 1

Do

Rows(sRow).Offset(1, 0).Select

Selection.Insert Shift:=xlDown

x = x + 1

Loop Until x = 4

Do

lRow = Range("A" & Rows.Count).End(xlUp).Offset(-2, 0).Row

Range("A38:P38").Select

Selection.AutoFill Destination:=Range("A38:P" & lRow), Type:=xlFillDefault

y = y + 1

Loop Until y = 3

End Sub

Once again, thank you in advance for your advice.

Best regards,

wliang

Sorry to bother you again. I would like to insert some rows (say 4 rows) in between Row 38 and Row 40. After inserting the rows, I would like to have the formula in Row 38 to be dragged down to the blank rows.

I have referred to the codes that you have provided to me earlier and managed to insert 4 rows but the formula was not dragged down to the blank rows.

I have listed below the codes I used for your advice.

Sub LastRow()

Dim sRow As Integer

Dim lRow As Integer

Dim x As Integer

Dim y As Integer

sRow = Range("A38").Row

x = 1

y = 1

Do

Rows(sRow).Offset(1, 0).Select

Selection.Insert Shift:=xlDown

x = x + 1

Loop Until x = 4

Do

lRow = Range("A" & Rows.Count).End(xlUp).Offset(-2, 0).Row

Range("A38:P38").Select

Selection.AutoFill Destination:=Range("A38:P" & lRow), Type:=xlFillDefault

y = y + 1

Loop Until y = 3

End Sub

Once again, thank you in advance for your advice.

Best regards,

wliang

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

There is no need to open a new message as long as your questions refer to this query.

I'm a little bit confused about your second question.

You want to insert 4 rows after row 38.

1) Is it always going to be 4 rows or does this number alter from time to time?

You code only insert 3 rows by the way.

2) Is it always going to be after row 38 or does this number alter from time to time?

Then the autofilling.

3) Do you only want to autofill the formula's (column J:L) or the range used in the above code (column A:P)?

4) Do you want to autofill only the empty inserted rows or autofill til two rows before the end of the list like in the above code?

Please answer these 4 questions for me.

Best regards,

Trowa

There is no need to open a new message as long as your questions refer to this query.

I'm a little bit confused about your second question.

You want to insert 4 rows after row 38.

1) Is it always going to be 4 rows or does this number alter from time to time?

You code only insert 3 rows by the way.

2) Is it always going to be after row 38 or does this number alter from time to time?

Then the autofilling.

3) Do you only want to autofill the formula's (column J:L) or the range used in the above code (column A:P)?

4) Do you want to autofill only the empty inserted rows or autofill til two rows before the end of the list like in the above code?

Please answer these 4 questions for me.

Best regards,

Trowa

Hi Trowa,

Thanks for your feedback.

Referring to Q1 and Q2, I would like to have it fixed that everytime the macro is run, it will insert 4 rows. At the moment, it shall always be after row 38 to insert the blank rows.

As for Q3 and Q4, I want to autofill the formula for the range used in the above code, i.e. fill the formula from A8:P8. The autofill shall fill until 2 rows before the end of the list as I have a row after that for summing up of the figures, i.e. the autofill shall not overwrite the row that I use for summing up.

I am trying to create a new layout for the customer packing list with reference to the packing sheet. You can refer to the attached file:

http://www.speedyshare.com/files/29680235/DPS_Shipment_Packing_V2.52.xls

Thanks in advance for your support.

Best regards,

wliang

Thanks for your feedback.

Referring to Q1 and Q2, I would like to have it fixed that everytime the macro is run, it will insert 4 rows. At the moment, it shall always be after row 38 to insert the blank rows.

As for Q3 and Q4, I want to autofill the formula for the range used in the above code, i.e. fill the formula from A8:P8. The autofill shall fill until 2 rows before the end of the list as I have a row after that for summing up of the figures, i.e. the autofill shall not overwrite the row that I use for summing up.

I am trying to create a new layout for the customer packing list with reference to the packing sheet. You can refer to the attached file:

http://www.speedyshare.com/files/29680235/DPS_Shipment_Packing_V2.52.xls

Thanks in advance for your support.

Best regards,

wliang

- Posts
- 2441
- Registration date
- Sunday September 12, 2010
- Status
- Contributor
- Last seen
- December 18, 2018

Hi Wliang,

I made some minor adjustments to the code.

See if this yields the desired result:

Best regards,

Trowa

I made some minor adjustments to the code.

See if this yields the desired result:

Sub LastRow() Dim sRow As Integer Dim lRow As Integer Dim x As Integer sRow = Range("A38").Row x = 0 Do Rows(sRow).Select Selection.Insert Shift:=xlDown x = x + 1 Loop Until x = 4 lRow = Range("A" & Rows.Count).End(xlUp).Row Range("A8:P8").Select Selection.AutoFill Destination:=Range("A8:P" & lRow), Type:=xlFillDefault End Sub

Best regards,

Trowa