Allgemeines Modul via Makro übertragen

Sub Aufteilen_PMP()
'Variablen definieren
Dim objDictionary As Object
Dim objCell As Range, objCopyRange As Range
Dim objWorkbook As Workbook
Dim ialngIndex As Long
Dim avntValues As Variant, avntKeys As Variant
Dim strFirstAddress As String
'Aufteilen starten
Application.ScreenUpdating = False
With ActiveSheet
avntValues = .Range(.Cells(2, 33), .Cells(.Rows.Count, 33).End(xlUp)).Value2
End With
Set objDictionary = CreateObject("Scripting.Dictionary")
For ialngIndex = LBound(avntValues) To UBound(avntValues)
objDictionary(avntValues(ialngIndex, 1)) = vbNullString
Next
avntKeys = objDictionary.Keys
Set objDictionary = Nothing
With ActiveSheet
For ialngIndex = LBound(avntKeys) To UBound(avntKeys)
Set objCell = .Columns(33).Find(What:=avntKeys(ialngIndex), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not objCell Is Nothing Then
strFirstAddress = objCell.Address
Set objCopyRange = .Cells(1, 1)
Do
Set objCopyRange = Union(objCopyRange, objCell)
Set objCell = .Columns(33).FindNext(objCell)
Loop Until objCell.Address = strFirstAddress
Set objWorkbook = Workbooks.Add(xlWBATWorksheet)
objCopyRange.EntireRow.Copy Destination:=objWorkbook.Worksheets(1).Cells(1,  _
_
1)
Cells.Select
Cells.EntireColumn.AutoFit
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
'Hilfsspalten hiden
Columns("AG:AH").Select
Selection.EntireColumn.Hidden = True
'Import
With ActiveWorkbook.VBProject
.VBComponents.Import "C:\Users\ABCXYZ\Desktop\Module2.bas"
End With
' File speichern
ActiveWorkbook.SaveAs Filename:="R:\Products\Portfolio 2016\Products per Store\" _
_
& avntKeys(ialngIndex) & "_ProductManagement.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
Set objWorkbook = Nothing
Set objCell = Nothing
Set objCopyRange = Nothing
End If
Next
End With
'Hilfspalten beim "Hauptdokument" wieder hiden
Columns("AG:AH").Select
Selection.EntireColumn.Hidden = True
Application.ScreenUpdating = True
End Sub