VBA Hilfe gesucht

Guten Abend zusammen,

ich bin ein VBA Neuling und gerade dabei meine ersten kleinen Projekte umzusetzen. Derzeit versuche ich mich an einer Prozedur, die meine derzeitige Arbeitsmappe unter einem neuen Namen abspeichert. Der neue Name soll dabei variabel ermittelt werden.

Zum Aufbau meiner Datei (ich kann sie leider nicht hochladen)

Verschiedene Reiter, die unterschiedliche Formen von Checklisten enthalten

Neben den unterschiedlichen Checklisten gibt es noch die Reiter "dd" und "dyn.dd". Diese enthalten Dropdown-Daten um die unterschiedlichen Checklisten befüllen zu können

Jede Checkliste enthält die Felder "Pers.-Nr.:", "Name" und "Vorname" in der gleichen Schreibweise. Dies ist wichtig, da ich die Eingabefelder für die Benennung der neuen Datei verwenden möchte

Die Eingabefelder für "Pers.-Nr.:", "Name" und "Vorname" sind jeweils mit einem offset (0,2) rechts daneben (in jeder Checkliste)

Ich stehe vor der Herausforderung, dass die drei oben genannten Felder zwar in jeder Checkliste gleich benannt sind, sich aber immer an unterschiedlichen Positionen befinden. Deshalb habe ich versucht die Namen der Felder über

Range.Find

zu ermitteln und so die Eingaben in den neuen Datei-Namen zu speisen.

Das Makro wird auf jedem Arbeitsblatt über einen Button in der Checkliste gestartet. Die neue Datei, die gespeichert werden soll, soll immer das gerade aktive Tabellenblatt (auf dem das Makro gestartet wurde) und die Tabellenblätter "dd" und "dyn.dd" enthalten.

Was mich momentan am meisten verwirrt ist, dass mein Makro in der 1. Checkliste funktioniert. In allen anderen bekomme ich leider einen Laufzeitfehler 1004. "Die Methode SaveAs für das Objekt Workbook ist fehlgeschlagen" Ich markiere die Stelle unten im Code.

Ich hoffe, dass ich die Problematik halbwegs verständlich beschrieben habe.

Hier einmal der Code den ich derzeit habe:

Option Explicit



'Konstanten festlegen

Const DOCUMENT_NAME_PREFIX As String = "yymmdd.s_"

Const FILE_FORMAT As Long = 51 '51  steht für xlOpenXMLWorkbook



Sub ChecklisteSpeichern()



'Variablen dimensionieren

Dim filename As String

Dim findRangeVorname As Range

Dim findRangeName As Range

Dim findRangePSNR As Range



Set findRangeVorname = ActiveSheet.Range("A:Z").Find(What:="Vorname", LookIn:=xlValues, LookAt:=xlWhole)

Set findRangeName = ActiveSheet.Range("A:Z").Find(What:="Name", LookIn:=xlValues, LookAt:=xlWhole)

Set findRangePSNR = ActiveSheet.Range("A:Z").Find(What:="Pers.-Nr.:", LookIn:=xlValues, LookAt:=xlWhole)



    If Not findRangeVorname Is Nothing And Not findRangeName Is Nothing And Not findRangePSNR Is Nothing Then

    Dim foundCellVorname As Range

    Dim foundCellName As Range

    Dim foundCellPSNR As Range



    Set foundCellVorname = findRangeVorname.Offset(0, 2)

    Set foundCellName = findRangeName.Offset(0, 2)

    Set foundCellPSNR = findRangePSNR.Offset(0, 2)



    filename = Format(Now, DOCUMENT_NAME_PREFIX) & ActiveSheet.Name & "_" & foundCellName.Value & "_" & foundCellVorname.Value & "_" & foundCellPSNR.Value



    End If



Application.DisplayAlerts = False



ThisWorkbook.sheets(Array(ActiveSheet.Name, "dd", "dyn.dd")).Copy

With ActiveWorkbook

    .SaveAs filename & ".xlsx", FileFormat:=FILE_FORMAT

    .Close savechanges:=True

End With



frmSpeicherung.Show



Application.DisplayAlerts = True



End Sub

Ich bin um jede Hilfe dankbar :)

LG
David

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ChecklisteSpeichern() Dim SuchErg As Range Dim DateiName As String Dim wb As Workbook With ActiveSheet.Range("A:Z") Set SuchErg = .Find(What:="Vorname", LookIn:=xlValues, LookAt:=xlWhole) If Not SuchErg Is Nothing Then DateiName = Format(Now, "yymmdd.s") & "_" & SuchErg.Offset(0, 2).Value Set SuchErg = .Find(What:="Name", LookIn:=xlValues, LookAt:=xlWhole) If Not SuchErg Is Nothing Then DateiName = DateiName & "_" & SuchErg.Offset(0, 2).Value Set SuchErg = .Find(What:="Pers.-Nr.:", LookIn:=xlValues, LookAt:=xlWhole) If Not SuchErg Is Nothing Then DateiName = DateiName & "_" & SuchErg.Offset(0, 2).Value & ".xlsx" Application.DisplayAlerts = False Set wb = ThisWorkbook.Sheets(Array(ActiveSheet.Name, "dd", "dyn.dd")).Copy wb.SaveAs DateiName, FileFormat:=xlOpenXMLWorkbook wb.Close savechanges:=True Application.DisplayAlerts = True frmSpeicherung.Show End If End If End If End With End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread