I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Hi Stabilo,

Try:

'=======================
Public Sub Tester()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = Range("A15") '<<=========== CHANGE

rCell(2).Resize(10).EntireRow.Insert shift:=xlUp
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).PasteSpecial Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Hi Norman,

thanks
a lot for the fast reply. I have test it but it seems that is not working as
expected.
In fact if you run several time the same code you will see that it keeps
adding 10 rows instead of just overwritting the existing new 10 rows.

Do you have time to have a look ? also How can I change the code so the
rCell is equal to the current selected row (and not the "A15")


"Norman Jones" wrote:

Hi Stabilo,

Try:

'=======================
Public Sub Tester()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = Range("A15") '<<=========== CHANGE

rCell(2).Resize(10).EntireRow.Insert shift:=xlUp
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).PasteSpecial Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Hi Stabilo,

How can I change the code so the
rCell is equal to the current selected row (and not the "A15")


Try:

'=====================
Public Sub Tester2()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = ActiveCell

rCell(2).Resize(10).EntireRow.Insert shift:=xlDown
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).EntireRow.PasteSpecial _
Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<,=====================


I have test it but it seems that is not working as expected.
In fact if you run several time the same code you will see that it keeps
adding 10 rows instead of just overwritting the existing new 10 rows.

If code to insert rows is run multiple times, multiple insertions will
normally occur.

If your intention is not to insert any rows but rather, simply to format
the 10 rows after the active cell, then try:

'=======================
Sub Tester02()

ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).Resize(10).EntireRow.PasteSpe cial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
ActiveCell.Select

End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
Hi Norman,

thanks
a lot for the fast reply. I have test it but it seems that is not working
as
expected.
In fact if you run several time the same code you will see that it keeps
adding 10 rows instead of just overwritting the existing new 10 rows.

Do you have time to have a look ? also How can I change the code so the
rCell is equal to the current selected row (and not the "A15")


"Norman Jones" wrote:

Hi Stabilo,

Try:

'=======================
Public Sub Tester()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = Range("A15") '<<=========== CHANGE

rCell(2).Resize(10).EntireRow.Insert shift:=xlUp
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).PasteSpecial Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row)
and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout
the
values .

Has it be already done ? thanks

Great thanks perfect.

It is ok now. Thank you so much for your help



"Norman Jones" wrote:

Hi Stabilo,

How can I change the code so the
rCell is equal to the current selected row (and not the "A15")


Try:

'=====================
Public Sub Tester2()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = ActiveCell

rCell(2).Resize(10).EntireRow.Insert shift:=xlDown
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).EntireRow.PasteSpecial _
Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<,=====================


I have test it but it seems that is not working as expected.
In fact if you run several time the same code you will see that it keeps
adding 10 rows instead of just overwritting the existing new 10 rows.

If code to insert rows is run multiple times, multiple insertions will
normally occur.

If your intention is not to insert any rows but rather, simply to format
the 10 rows after the active cell, then try:

'=======================
Sub Tester02()

ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).Resize(10).EntireRow.PasteSpe cial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
ActiveCell.Select

End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
Hi Norman,

thanks
a lot for the fast reply. I have test it but it seems that is not working
as
expected.
In fact if you run several time the same code you will see that it keeps
adding 10 rows instead of just overwritting the existing new 10 rows.

Do you have time to have a look ? also How can I change the code so the
rCell is equal to the current selected row (and not the "A15")


"Norman Jones" wrote:

Hi Stabilo,

Try:

'=======================
Public Sub Tester()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = Range("A15") '<<=========== CHANGE

rCell(2).Resize(10).EntireRow.Insert shift:=xlUp
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).PasteSpecial Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row)
and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout
the
values .

Has it be already done ? thanks

Norman,

I have retested it, and it seems ok. However if the cells have borders on
rows 15, it is only the the first cell of each new row that have the borders ?

"stabilo" wrote:

Hi Norman,

thanks
a lot for the fast reply. I have test it but it seems that is not working as
expected.
In fact if you run several time the same code you will see that it keeps
adding 10 rows instead of just overwritting the existing new 10 rows.

Do you have time to have a look ? also How can I change the code so the
rCell is equal to the current selected row (and not the "A15")


"Norman Jones" wrote:

Hi Stabilo,

Try:

'=======================
Public Sub Tester()
Dim rCell As Range

Application.ScreenUpdating = True

Set rCell = Range("A15") '<<=========== CHANGE

rCell(2).Resize(10).EntireRow.Insert shift:=xlUp
rCell.EntireRow.Copy
rCell.Offset(1).Resize(10).PasteSpecial Paste:=xlPasteFormats
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
'<<=======================


---
Regards,
Norman



"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Stabilo,
This should do it, assuming the cursor is in row 16. The formats for row 15
should automatically be copied to the 10 new rows, but if they don't in your
version of Excel, you can use the second macro below to force the row 16
formats to carry over.
Roy

Sub Insert10Rows()
ActiveCell.Rows("1:10").EntireRow.Insert
End Sub
----------------------------------------------------------------------

Sub Insert10RowsF()
ActiveCell.Rows("1:10").EntireRow.Insert
ActiveCell.Rows("1:1").EntireRow.Copy
ActiveCell.Rows("1:10").EntireRow.PasteSpecial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
----------------------------------------------------------------------


"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Thanks Roy,

both seems ok but they do not copy the borders, how can you code copy the
borders as well ?

"Roy Harrill" wrote:

Stabilo,
This should do it, assuming the cursor is in row 16. The formats for row 15
should automatically be copied to the 10 new rows, but if they don't in your
version of Excel, you can use the second macro below to force the row 16
formats to carry over.
Roy

Sub Insert10Rows()
ActiveCell.Rows("1:10").EntireRow.Insert
End Sub
----------------------------------------------------------------------

Sub Insert10RowsF()
ActiveCell.Rows("1:10").EntireRow.Insert
ActiveCell.Rows("1:1").EntireRow.Copy
ActiveCell.Rows("1:10").EntireRow.PasteSpecial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
----------------------------------------------------------------------


"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Stabilo,
Sorry 'bout that. A slight alteration to the second macro should take care
of the borders. (The first macro will not copy the borders, as you
discovered, so you can scrap it.)

Sub InsertRowFB()
ActiveCell.Rows("1:10").EntireRow.Insert
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Copy
ActiveCell.Rows("1:10").EntireRow.PasteSpecial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub


HTH, Roy


"stabilo" wrote in message
...
Thanks Roy,

both seems ok but they do not copy the borders, how can you code copy the
borders as well ?

"Roy Harrill" wrote:

Stabilo,
This should do it, assuming the cursor is in row 16. The formats for row
15
should automatically be copied to the 10 new rows, but if they don't in
your
version of Excel, you can use the second macro below to force the row 16
formats to carry over.
Roy

Sub Insert10Rows()
ActiveCell.Rows("1:10").EntireRow.Insert
End Sub
----------------------------------------------------------------------

Sub Insert10RowsF()
ActiveCell.Rows("1:10").EntireRow.Insert
ActiveCell.Rows("1:1").EntireRow.Copy
ActiveCell.Rows("1:10").EntireRow.PasteSpecial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
----------------------------------------------------------------------


"stabilo" wrote in message
...
I need to insert 10 rows after a specifc row (let's call it source row)
and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row
below
row 15 with the same formating (eg. border, shading, font,...) wihtout
the
values .

Has it be already done ? thanks

This might come close, it will not matter how many rows are selcted at first,
it will go to the bottom of the selction.

Sub Macro1()
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Rows("1:9").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:9").EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Thanks,
--
David


"stabilo" wrote:

I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Thanks David,

This code seems to give an error when after it runs I see that cursor is at
the end of the worksheet row 65536

"David" wrote:

This might come close, it will not matter how many rows are selcted at first,
it will go to the bottom of the selction.

Sub Macro1()
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Rows("1:9").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:9").EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Thanks,
--
David


"stabilo" wrote:

I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks

Hi,
It assumes you are not in the very last row that has data. Will there always
be data in the rows, prior to the format you want copied down to the inserted
rows? If that is true, you can put this line as the first line in the code,
which will put you in cell "A1", then it will go down to the last row with
data, then do the insertion and past formats.

Range("A1").select

Thanks,
--
David


"stabilo" wrote:

Thanks David,

This code seems to give an error when after it runs I see that cursor is at
the end of the worksheet row 65536

"David" wrote:

This might come close, it will not matter how many rows are selcted at first,
it will go to the bottom of the selction.

Sub Macro1()
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Rows("1:9").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:9").EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Thanks,
--
David


"stabilo" wrote:

I need to insert 10 rows after a specifc row (let's call it source row) and
the new rows have to have the same formating as the source row.

So if I have a cell on row 15 selected, the macro should insert 10 row below
row 15 with the same formating (eg. border, shading, font,...) wihtout the
values .

Has it be already done ? thanks