Neue Datei per Klick mit Datenübernahme

[Planlos2015]

Hallo zusammen,

ich stehe vor einer Herausforderung: Ich muss etwa 150 personalisierte Excel-Dateien erstellen, die Informationen wie Namen, Auszahlungshöhe, Prozentsätze usw. enthalten. Es gibt bereits eine Musterdatei (für die 150 Dateien), die Formeln für bestimmte Einschränkungen und Zellschutz für bestimmte Bereiche enthält.

Ich habe eine "Masterdatei", in der alle Daten in einer Tabelle organisiert sind. Ich frage mich, ob es möglich ist, eine Schaltfläche oder einen Button in der letzten Spalte einzufügen, mit dem eine neue Datei basierend auf der Musterdatei erstellt wird, die die jeweiligen Daten enthält. Es wäre ideal, wenn ich auch den Speicherort und den Namen der erstellten Datei festlegen könnte.

Normalerweise finde ich in Foren schnell eine Anleitung, aber diesmal hatte ich leider kein Glück (oder nicht die richtigen Suchbegriffe).

Vielen Dank im Voraus für eure Hilfe! 

Viele Grüße
Lisa

[schauan]

Hallo Lisa,

im Prinzip könnte man so vorgehen:

- Liste erstellen mit den Namen und zugehörigen Speicherorten der Dateien
- Makro erstellen, welches in einer Schleife die Liste abarbeitet

Code:

Sub Kopieren()
Dim strQuelle, strZiel$, iCnt%
'Quelldatei festlegen
strQuelle = "C:\Test\Quelldatei.xlsx"
'Zeilenzähler Startzeile festlegen
iCnt = 1
'Pfad und Name erste Zieldatei aus Liste uebernehmen
'(Blatt mit Liste muss aktiv sein
'Pfad in Spalte A, Dateiname in Spalte B, Pfad mit abschliessendem \)
strZiel = Cells(iCnt, 1).Value & Cells(iCnt, 2).Value
'Schleife solange strZiel was enthaelt
'( ... ueber alle gelisteten Dateien)
Do While strZiel <> ""
  'Kopieren
  FileCopy strQuelle, strZiel
  'Zeilenzaehler hochsetzen
  iCnt = iCnt + 1
  'naechsten Pfad + Datei aus Liste holen
  strZiel = Cells(iCnt, 1).Value & Cells(iCnt, 2).Value
'Ende Schleife solange strZiel was enthaelt
Loop
MsgBox "Fertig!"
End Sub

[RPP63]

Normalerweise finde ich in Foren schnell eine Anleitung, aber diesmal hatte ich leider kein Glück (oder nicht die richtigen Suchbegriffe).

Moin Lisa!
Welche Antwort erwartest Du denn?
Schließlich ist die Threaderöffnung viel zu allgemein gehalten, als dass man konkrete Hilfe geben könnte.

mit dem eine neue Datei basierend auf der Musterdatei erstellt wird, die die jeweiligen Daten enthält.

"Masterdatei":
Tabelle mit Datensätzen für Kunden oder Mitarbeiter
"Musterdatei":
Vorlage, die gefüllt werden soll

→ Lade beide Dateien (anonymisiert) hier hoch, damit wir nicht auch planlos sind.

Gruß Ralf

[Andreas Killer]

ich stehe vor einer Herausforderung: Ich muss etwa 150 personalisierte Excel-Dateien erstellen, die Informationen wie Namen, Auszahlungshöhe, Prozentsätze usw. enthalten. Es gibt bereits eine Musterdatei (für die 150 Dateien), die Formeln für bestimmte Einschränkungen und Zellschutz für bestimmte Bereiche enthält.

Ich habe eine "Masterdatei", in der alle Daten in einer Tabelle organisiert sind. 

Hallo Lisa,

das ist recht einfach.

Die Tabelle in der Masterdatei enthält Überschriften und wenn es nun in der Musterdatei Zellen gibt die nach diesen Überschriften benannt sind, dann ist das Ausfüllen eine Kleinigkeit.
Lad Dir mal diese Datei herunter und entpacke sie in ein leeres Verzeichnis.

  Z.zip (Größe: 22,31 KB / Downloads: 3)

Öffne beide Dateien, in der Musterdatei habe ich die Zielzellen zum Verständnis eingefärbt.

Lass das Makro Main laufen und der Code füllt jede Zeile in der Musterdatei aus und speichert diese mit dem Namen aus der ersten Spalte der Datentabelle ab.

Das kannst Du so in Deiner Datei nachbauen, der Code ist universell und braucht keine Änderung. Alles klar?

Andreas.

[Planlos2015]

Erstmal danke für die schnellen Lösungsvorschläge! Ich habe nun folgenden Code verwendet und es funktioniert 

Code:

Option Explicit
' === Hauptmakro: erstellt pro Zeile eine neue Excel-Datei ===
Sub Erstelle_Datei_Aus_Zeile()
    Dim wsQuelle As Worksheet
    Dim Zeile As Long
    Dim VorlagePfad As String
    Dim ZielOrdner As String
    Dim wbVorlage As Workbook
    Dim wsZiel As Worksheet
    Dim NameDatei As String
    Dim ZielPfad As String
    Dim Antwort As VbMsgBoxResult
   
    ' === Grundeinstellungen ===
    Set wsQuelle = ThisWorkbook.Sheets("TABELLENBLATTNAME")
    VorlagePfad = "PFAD MUSTERDATEI"
    ZielOrdner = "PFAD, WO DATEI ABGESPEICHERT WERDEN SOLL"
   
    ' Zeile bestimmen, in der der Button gedrückt wurde
    On Error Resume Next
    Zeile = wsQuelle.Buttons(Application.Caller).TopLeftCell.Row
    On Error GoTo 0
   
    If Zeile < 2 Then
        MsgBox "Fehler: Zeile konnte nicht ermittelt werden.", vbExclamation
        Exit Sub
    End If
   
    ' === Name und Pfad der neuen Datei ===
    NameDatei = wsQuelle.Cells(Zeile, "B").Value & " OPTINALE BENENNUNG DATEI"
    ZielPfad = ZielOrdner & NameDatei & ".xlsx"
   
    ' Prüfen, ob Datei schon existiert
    If Dir(ZielPfad) <> "" Then
        Antwort = MsgBox("Die Datei '" & ZielPfad & "' existiert bereits." & vbCrLf & _
                         "Möchten Sie sie überschreiben?", vbYesNo + vbQuestion, "Datei existiert bereits")
        If Antwort = vbNo Then
            MsgBox "Datei wurde nicht überschrieben.", vbInformation
            Exit Sub
        End If
    End If
   
    ' === Vorlage öffnen ===
    Set wbVorlage = Workbooks.Open(VorlagePfad)
    Set wsZiel = wbVorlage.Sheets(1)
   
    ' === Werte übertragen ===
    With wsZiel
        .Range("B4").Value = wsQuelle.Cells(Zeile, "B").Value
        .Range("B5").Value = wsQuelle.Cells(Zeile, "J").Value
        .Range("B6").Value = wsQuelle.Cells(Zeile, "D").Value
        .Range("E7").Value = wsQuelle.Cells(Zeile, "P").Value
        .Range("E9").Value = wsQuelle.Cells(Zeile, "P").Value
        .Range("C18").Value = wsQuelle.Cells(Zeile, "T").Value
        .Range("B20").Value = wsQuelle.Cells(Zeile, "U").Value
        .Range("C24").Value = wsQuelle.Cells(Zeile, "V").Value
        .Range("C29").Value = wsQuelle.Cells(Zeile, "W").Value
        .Range("B31").Value = wsQuelle.Cells(Zeile, "X").Value
        .Range("D31").Value = wsQuelle.Cells(Zeile, "Y").Value
        .Range("C35").Value = wsQuelle.Cells(Zeile, "Z").Value
        .Range("B39").Value = wsQuelle.Cells(Zeile, "X").Value
        .Range("D39").Value = wsQuelle.Cells(Zeile, "AA").Value
        .Range("C40").Value = wsQuelle.Cells(Zeile, "AB").Value
        .Range("C43").Value = wsQuelle.Cells(Zeile, "AC").Value
        .Range("C47").Value = wsQuelle.Cells(Zeile, "AD").Value
    End With
   
    ' === Datei speichern ===
    wbVorlage.SaveAs ZielPfad, FileFormat:=xlOpenXMLWorkbook
    wbVorlage.Close SaveChanges:=False
   
    MsgBox "✅ Neue Datei erstellt:" & vbCrLf & ZielPfad, vbInformation, "Fertig!"
End Sub

' === Buttons automatisch in Spalte AF einfügen ===
Sub Buttons_automatisch_erstellen()
    Dim ws As Worksheet
    Dim letzteZeile As Long
    Dim i As Long
    Dim btn As Button
    Dim letzteSpalte As Long
   
    Set ws = ThisWorkbook.Sheets("TABELLENNAME")
    letzteZeile = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    letzteSpalte = ws.Range("AF1").Column ' Buttons in Spalte AF
   
    ' Alte Buttons löschen
    For Each btn In ws.Buttons
        btn.Delete
    Next btn
   
    ' Neue Buttons erstellen
    For i = 2 To letzteZeile
        Set btn = ws.Buttons.Add( _
            Left:=ws.Cells(i, letzteSpalte).Left + 5, _
            Top:=ws.Cells(i, letzteSpalte).Top + 2, _
            Width:=70, Height:=18)
        btn.Caption = "BUTTONNAME"
        btn.OnAction = "Erstelle_Datei_Aus_Zeile"
    Next i
   
    MsgBox (letzteZeile - 1) & " Buttons in Spalte AF erstellt.", vbInformation
End Sub

Ich habe für die Anonymisierung alle Pfade etc. in Caps geändert, damit man es leichter für sich ändern kann. Aber die Bezüge für die spezifischen Spalten und Zellen würden auch geändert werden müssen.

Nochmal Danke für die Anregungen und Lösungsvorschläge