if sticking to VBA you could use the "CopyObjects" method of the Document or Database object
the following code copies all object from the active document to a newly created one but you can simply adapt it to your needs
Code:
Option Explicit
Sub CopyAllObjects()
Dim sourceDwg As AcadDocument, destDwg As AcadDocument
Set sourceDwg = ActiveDocument
Set destDwg = Documents.Add
sourceDwg.CopyObjects allObjectsArray(selectAllObjects(sourceDwg)), destDwg.ModelSpace
End Sub
and here they are the called functions
Code:
Function selectAllObjects(myDoc As AcadDocument) As AcadSelectionSet
Set selectAllObjects = CreateSelectionSet("mySel", myDoc)
myDoc.Application.ZoomAll
selectAllObjects.Select acSelectionSetAll
End Function
Code:
Function allObjectsArray(ss As AcadSelectionSet)
Dim iEnt As Long
ReDim Objects(0 To ss.Count - 1) As AcadEntity
For iEnt = 0 To ss.Count - 1
Set Objects(iEnt) = ss.Item(iEnt)
Next iEnt
allObjectsArray = Objects
End Function
Code:
Function CreateSelectionSet(SSset As String, Optional myDoc As Variant) As AcadSelectionSet
If IsMissing(myDoc) Then Set myDoc = ThisDrawing
On Error Resume Next
Set CreateSelectionSet = myDoc.SelectionSets(SSset)
If Err Then
Set CreateSelectionSet = myDoc.SelectionSets.Add(SSset)
Else
CreateSelectionSet.Clear
End If
End Function