Paste rows from another sheet

[pioshelby1980com]

Hi,

I have the following that copies rows from a "template" sheet into the active row on another sheet. I have tried a few different methods to copy the row height but this is the only one I could get to work properly. The issue I have is that the rows that get pushed down take on the default row height of 15 and do not keep the row height they had prior to the copy. Can anyone help with this please?

Option Explicit


Sub InsertTemplateAtActiveRow()
    Dim ws As Worksheet
    Dim templateSheet As Worksheet
    Dim activeRow As Integer
    Dim templateRange As Range


    ' Set the active sheet
    Set ws = ActiveSheet


    ' Set the template sheet
    Set templateSheet = ThisWorkbook.Sheets("Templates")


    ' Get the active row
    activeRow = ActiveCell.Row


    ' Set the range to be inserted (adjust the range as needed)
    Set templateRange = templateSheet.Range("A4:R16") ' Change this to the range you want to copy


    ' Insert the template range at the active row
    templateRange.Copy
    ws.Rows(activeRow).Insert Shift:=xlDown
    
           ws.Rows(activeRow - 1).RowHeight = 10
            ws.Rows(activeRow).RowHeight = 5
            ws.Rows(activeRow + 1).RowHeight = 30
            ws.Rows(activeRow + 2).RowHeight = 20
            ws.Rows(activeRow + 3).RowHeight = 5
            ws.Rows(activeRow + 4).RowHeight = 20
            ws.Rows(activeRow + 5).RowHeight = 5
            ws.Rows(activeRow + 6).RowHeight = 30
            ws.Rows(activeRow + 7).RowHeight = 20
            ws.Rows(activeRow + 8).RowHeight = 20
            ws.Rows(activeRow + 9).RowHeight = 20
            ws.Rows(activeRow + 10).RowHeight = 20
            ws.Rows(activeRow + 11).RowHeight = 5


    ' Clear the clipboard
    Application.CutCopyMode = False


    ' Notify user
    MsgBox "Template inserted at the active row successfully.", vbInformation
End Sub

 

[Sam_D_Ben]

You mean this :

    ThisWorkbook.Sheets("Templates").Range("A4:R16").Copy
    ThisWorkbook.Sheets("Templates").Range("A4:R16").PasteSpecial xlValues
    ThisWorkbook.Sheets("Templates").Range("A4:R16").PasteSpecial xlFormats

Thanks

 

[pioshelby1980com]

Thanks Sam,
How do I put this into the code? This is what I tried:

Option Explicit




Sub InsertTemplateAtActiveRowShort()
    Dim ws As Worksheet
    Dim templateSheet As Worksheet
    Dim activeRow As Integer
    Dim templateRange As Range


    ' Set the active sheet
    Set ws = ActiveSheet


    ' Set the template sheet
    Set templateSheet = ThisWorkbook.Sheets("Templates")


    ' Get the active row
    activeRow = ActiveCell.Row


ThisWorkbook.Sheets("Templates").Range("A4:R16").Copy
  ws.Rows(activeRow).Insert Shift:=xlDown
ThisWorkbook.Sheets("Templates").Range("A4:R16").PasteSpecial xlValues
ThisWorkbook.Sheets("Templates").Range("A4:R16").PasteSpecial xlFormats
'ThisWorkbook.Sheets("Templates").Range("A4:R16").PasteSpecial Paste:=xlPasteRowHeights


    ' Clear the clipboard
    Application.CutCopyMode = False


    ' Notify user
    MsgBox "Template inserted at the active row successfully.", vbInformation
End Sub

It will copy the rows and paste them in but the row heights are not copied over and the rows that are pushed down do not retain there row heights either.

Thanks.

 

[pioshelby1980com]

Hi,

Can anyone help me with this please?

Thanks.

 

[Sam_D_Ben]

Could you please provide a snapshot of your data prior to and following the change?

Thanks