Private Sub ExportAllStdModules(newWbk As Workbook, oldWbk As Workbook) ' скопировать все компоненты VBA в новую книгу
Dim iTempPath As String, iModuleName As String
Dim iVBComponent As Object
Dim a As Boolean
With Application
.ScreenUpdating = False
iTempPath = .DefaultFilePath & .PathSeparator
With newWbk.VBProject.VBComponents
For Each iVBComponent In oldWbk.VBProject.VBComponents
iModuleName$ = iTempPath$ & iVBComponent.Name
a = CopyModule(iVBComponent.Name, _
oldWbk.VBProject, _
newWbk.VBProject, True)
Next
End With
.ScreenUpdating = True
End With
End Sub

Function CopyModule(ModuleName As String, _
FromVBProject, _
ToVBProject, _
OverwriteExisting As Boolean) As Boolean
Dim VBComp As Object 'As VBIDE.VBComponent
Dim FName$, CompName$, S$
Dim SlashPos&, ExtPos&
Dim TempVBComp 'As VBIDE.VBComponent
Dim vbext_pp_locked As Boolean
On Error Resume Next
Set VBComp = FromVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
End If
With ToVBProject.VBComponents
.Remove .Item(ModuleName)
End With
Else
Err.Clear
Set VBComp = ToVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
If Err.Number = 9 Then
' module doesn't exist. ignore error.
Else
' other error. get out with return value of False
CopyModule = False
Exit Function
End If
End If
End If
FromVBProject.VBComponents(ModuleName).Export FileName:=FName
SlashPos = InStrRev(FName, "\")
ExtPos = InStrRev(FName, ".")
CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
Set VBComp = Nothing
Set VBComp = ToVBProject.VBComponents(CompName)
If VBComp Is Nothing Then
ToVBProject.VBComponents.Import FileName:=FName
Else
Set TempVBComp = ToVBProject.VBComponents.Import(FName)
' TempVBComp is source module
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
.InsertLines 1, S
End With
On Error GoTo 0
ToVBProject.VBComponents.Remove TempVBComp
End If
Kill FName
CopyModule = True
End Function