Copy and Paste multiple rows within a range

[demitri]

I need help writing a macro to automate a specific set of actions. I have a range of multiple rows containing various component data (product description, quantity, unit pricing, and total pricing) for a specific product. At the bottom of the section, I have a summary with totals.

Component Type	Component Description	QTY	Unit Cost	Total Cost
Product A
Component 1
Component 2
Component 3
Component 4
Component 5
Component 6
Component 7
Component 8
Pricing Summary

<tbody>
</tbody>

I want the macro to add a new Product (Product B) by copying and pasting all of the rows in Product A -- including the header -- two lines below the last component of Product A to create spacing between products.
When I run the macro again, it should create a new product (Product C) by copying and pasting all of the rows in Product B two lines below Product B and so on.

Any help on this is much appreciated.

 

[cpatel13]

I need help writing a macro to automate a specific set of actions. I have a range of multiple rows containing various component data (product description, quantity, unit pricing, and total pricing) for a specific product. At the bottom of the section, I have a summary with totals.

Component Type	Component Description	QTY	Unit Cost	Total Cost
Product A
Component 1
Component 2
Component 3
Component 4
Component 5
Component 6
Component 7
Component 8
Pricing Summary

<tbody>
</tbody>

I want the macro to add a new Product (Product B) by copying and pasting all of the rows in Product A -- including the header -- two lines below the last component of Product A to create spacing between products.
When I run the macro again, it should create a new product (Product C) by copying and pasting all of the rows in Product B two lines below Product B and so on.

Any help on this is much appreciated.

Hie Dimitri,

Do you want that once you run the macro it copy's component 1 to component 8 from column A and then paste it below component 8 of product a. Do you also want the header component type?

 

[demitri]

Hie Dimitri,

Do you want that once you run the macro it copy's component 1 to component 8 from column A and then paste it below component 8 of product a. Do you also want the header component type?

Hi cpatel13,

Yes that's what I'm looking but I do not want to include the header.

Thanks in advance.

 

[cpatel13]

Hie Dimitri,

Do you want that once you run the macro it copy's component 1 to component 8 from column A and then paste it below component 8 of product a. Do you also want the header component type?

hie,
so far what i understood please find the code, please bear in mind that the code works on the structure what you have provided here, so if there is any changes from what you have posted and the original file, the code may not work properly.

Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Range("a" & LastRow - 2).Select
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell, ActiveCell.Offset(-8, 0)).Copy
    ActiveCell.Offset(2, 0).PasteSpecial xlPasteValues
    ActiveCell.Offset(9, 0).Select
    ActiveCell.Clear
End Sub

If any doubts do contact.

 

[demitri]

hie,
so far what i understood please find the code, please bear in mind that the code works on the structure what you have provided here, so if there is any changes from what you have posted and the original file, the code may not work properly.

Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Range("a" & LastRow - 2).Select
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.EntireRow.Insert
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell, ActiveCell.Offset(-8, 0)).Copy
    ActiveCell.Offset(2, 0).PasteSpecial xlPasteValues
    ActiveCell.Offset(9, 0).Select
    ActiveCell.Clear
End Sub

If any doubts do contact.

Thank you for this. I would like to expand this a bit because I have additional rows of data below what I initially provided and I should have been more clear. Because of the additional data below this section, when I run your code it finds the bottom most cell in column A and adds rows there. However, if this is the only data I had on my worksheet, this code would work great. I've attached a screen shot to show you a more accurate depiction of my sheet. Can you modify your initial code to accommodate this change?