21.03.2022, 23:11 
		
	
	
		Hallo,
Das was ich dir reingesetzt habe, ist eine Beispieldatei, welche aber alle Werkzeuge enthält, um ein Modul mit der Prozedur zu erzeugen/schreiben.
Da ich weder Zellinhalte noch die zu übertragende Prozedur kenne, teste diese Prozedur in einer Ausgangstabelle, welche die relevanten Daten in den für diese Prozedur benötigten Zellen enthält.
Ab Line 20 kannst du nach diesem Schema deine Prozedur, welche im Modul des neu erzeugten Arbeitsblattes stehen, eintragen.
Achte auf die Verweisaktivierung in der Bibliothek.
Ich hoffe es hilft dir weiter.
Gruß Uwe
	
Das was ich dir reingesetzt habe, ist eine Beispieldatei, welche aber alle Werkzeuge enthält, um ein Modul mit der Prozedur zu erzeugen/schreiben.
Da ich weder Zellinhalte noch die zu übertragende Prozedur kenne, teste diese Prozedur in einer Ausgangstabelle, welche die relevanten Daten in den für diese Prozedur benötigten Zellen enthält.
Ab Line 20 kannst du nach diesem Schema deine Prozedur, welche im Modul des neu erzeugten Arbeitsblattes stehen, eintragen.
Achte auf die Verweisaktivierung in der Bibliothek.
Code:
Option Explicit
Sub NeuesWorkbookErzeugen()
    Dim Wb As Workbook, Mdl As VBComponent, WbName As String
    Dim wkbName As String, wkbNeu As String, wksName As String
    Dim pfad As String, dateiname As String, strDname$
    wkbName = ThisWorkbook.Name
    wksName = ActiveSheet.Name
    Set Wb = Workbooks.Add(1)
    wkbNeu = Wb.Name
    pfad = "C:\Users\yyyy\Documents\Kunden\xxxx\"
    dateiname = "Auswertung Heatmap täglich vom " & Range("ah7") & " bis " & Range("ah8") & ".xlsm" 'mit Makro
    ' Verweis aktivieren "Microsoft Visual Basic for Applications Extensibility 5.3-Bibliothek" erforderlich!
    Set Mdl = Wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
    
    ' fügt Prozedur in neu erzeugtes Modul ein und benennt es um
    With Mdl.CodeModule
        .InsertLines 1, "Sub MeinModul()"
        .InsertLines 2, "'Durch eine Prozedur eingefügt"
        .InsertLines 3, "     MsgBox ""Das soll deine Prozedur sein"" "
        .InsertLines 4, "End Sub"
        .Name = "Mdl_Test"
    End With
    ' Übertragen der Datensätze in die neue Datei
    Workbooks(wkbName).Sheets(wksName).Range("A1:H6").Copy Workbooks(wkbNeu).Sheets(1).Range("A1")
    Workbooks(wkbName).Sheets(wksName).Range("A7:Z8000").Copy Workbooks(wkbNeu).Sheets(1).Range("A7")
    ' speichern
    strDname = pfad & dateiname
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
        ActiveWorkbook.SaveAs strDname, FileFormat:=xlOpenXMLWorkbookMacroEnabled  'mit Makro
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set Mdl = Nothing
    Set Wb = Nothing
    ActiveWorkbook.Close
End SubGruß Uwe

 
 

 

