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 Sub
Gruß Uwe