Insert Range of cells from one sheet to another with shifting cells down.

[PitMax]

Hi,
I am looking for the VBA that will copy and insert the range of cells from one sheet to another within the same workbook.

Ideally would be to run macro with button on the source sheet.

All items should be copied and inserted to blank document. The number of items (rows) in source sheet might be different (1~300). If it helps, I have available the cell that counts the number of lines (rows) that should be inserted.

After press the button, the ready document should have all items inserted and the cells in columns B8:F8 should be shifted down.

It is important to keep document formatting (border lines, font etc.)

It would be great If I could also back to blank document.

Does anyone know how it can be done?

Thank you in advance

 

[PitMax]

Ok. maybe too many inquiries . Let's focus on the basis.

I have found one small issue. When I have one item (one row), the Run-Time error '1004' appears:

What should be amend in the code to:
1) Copy and insert 11 columns.

2) run the button on the sheet 3 to copy from sheet1 to sheet2 and Sheet4?

Cheers,

 

[mohadin]

Sub test()
    Dim rng As Range
    Dim lr&
    With Sheets("Sheet2")
        lr = .Cells(Rows.Count, 5).End(xlUp).Row - 7
        If lr > 1 Then
            With .Cells(7, 2)
                .Resize(lr, 11).ClearContents
                .Resize(lr - 1, 11).Delete xlUp
            End With
        End If
    End With
    Range("A3:K3").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 2).Copy
    Sheets("Sheet2").Range("B7").Insert Shift:=xlDown
End Sub

 

[mohadin]

Sub test()
    Dim rng As Range
    Dim lr&
    With Sheets("Sheet2")
        lr = .Cells(Rows.Count, 5).End(xlUp).Row - 7
        If lr > 1 Then
            With .Cells(7, 2)
                .Resize(lr, 11).ClearContents
                .Resize(lr - 1, 11).Delete xlUp
            End With
        End If
    End With
    With Sheets("Sheet1")
    .Range("A3:K3").Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 2).Copy
    End With
    Sheets("Sheet2").Range("B7").Insert Shift:=xlDown
End Sub