создание layoutа из dwt используя vba

пытался написать прогу для вытаскивания готовых форматок из dwt-файла чере диалоговое окною
находится dwt, создаётся лист а вот объекты на него перенести не получается.
может кто знает как??
************************************
Dim objEnt As AcadObject
Dim objLayOut As AcadLayout
Dim drd As AcadLayout
Dim objNewLayOut As AcadLayout
Dim prot As AcadDocument
  Dim colLayOuts As AcadLayouts, lays As AcadLayouts
  Dim objEntArray() As Object
  Dim i As Integer
  Dim blc As Variant
  Dim intCnt As Integer
  Dim blnExists As Boolean
Private Sub give_nl_Click()
Dim objEnt As AcadObject
Dim cop As IAcadBlock2
Dim imya As AcadDatabase
AcDoc.Activate
Set lays = AcDoc.Layouts
Set collayots = prot.Layouts
For Each objLayOut In collayots
   If objLayOut.Name = namel.Value Then
     Set drd = objLayOut
     Exit For
     End If
Next
i = "1"
For Each objLayOut In lays
   If objLayOut.Name = drd.Name Then
      drd.Name = drd.Name & "-" & i
     i = i + "1"
     End If
Next
Dim strFrom As String, strTo As String
strFrom = drd.Name
strTo = strFrom
   Set objNewLayOut = lays.Add(strTo)
    Set objLayOut = colLayOuts.Item(strFrom)
    ReDim objEntArray(objLayOut.Block.Count - 1)
    intCnt = "0"
    For Each objEnt In objLayOut.Block
      Set objEntArray(intCnt) = objEnt
      intCnt = intCnt + 1
    Next
         Set blc = objLayOut.Block
    objNewLayOut.CopyFrom objLayOut
    ThisDrawing.ActiveLayout = objNewLayOut
     prot.Close False
  ins.Hide
End Sub
Private Sub UserForm_Activate()
Set AcDoc = ThisDrawing.Application.ActiveDocument
Set prot = ThisDrawing.Application.Documents.Open("C:\new\layout.dwt", True)
Set colLayOuts = prot.Layouts
For Each objLayOut In colLayOuts
    If objLayOut.Name <> "Model" Then
    namel.AddItem (objLayOut.Name)
    namel.Value = objLayOut.Name
    End If
    intCnt = intCnt + 1
   Next
End Sub
*****************************************