Private Sub ВставитьЗаголовки(ByVal shname As String, ByVal zagrng As String)
Dim zagrow As Integer, zagcol As Integer
Set wb = ThisWorkbook
Set ws1 = wb.Worksheets(shname)
Set ws2 = wb.Worksheets("Шапки")
Set r2 = ws2.Range(zagrng)
zagrow = r2.Rows.Count
zagcol = r2.Columns.Count
Set r1 = ws1.Cells(1, 1).CurrentRegion
For i = 1 To zagrow
    r1.Rows(1).Insert
    r1.Cells(1, 1).Offset(-1, 0).Value = "*"
Next i
Set r1 = ws1.Cells(1, 1).CurrentRegion
Set r1row = r1.Rows(1).Resize(RowSize:=zagrow)
r2.Copy r1row
For i = 1 To zagcol
    r1row.Columns(i).ColumnWidth = r2.Columns(i).ColumnWidth
Next i
For i = 1 To zagrow
    r1row.Rows(i).RowHeight = r2.Rows(i).RowHeight
Next i
End Sub

set r=ws1.Cells(1,1).CurrentRegion
set c=r.Cells(r.Rows.Count,1)
set c=c.Offset(2,0)
r2.Copy c