Hallo zusammen,
ich habe folgendes Anliegen (zu dem ich auch gern eine Beispieldatei erstellen kann, falls meine Beschreibung noch zu uneindeutig sein sollte).
Auf Sheet1 habe ich die Funktion, dass es mir über eine Dropdownliste nur die Kunden von dem jeweiligen Mitarbeiterkürzel anzeigt.
In Sheet2 habe ich eine Liste mit allen Kürzeln der Mitarbeiter.
Besteht die Möglichkeit aus dieser sogenannten Masterdatei Duplikate zu machen, die man dann mit Kürzel aus Sheet2 Spalte F benennt? und eventuell noch den Ort/Pfad per inputbox festlegen kann, wohin es diese ganzen Dateien speichern soll (ca. 20 Stück)?
Bevor man diese Dateien vervielfältigen würde, könnte man dann noch aus dem Sheet2 Spalte F das Kürzel an eine bestimmte Position in Sheet1 (Sheet1 D2) fügen und dann diese Zelle zu sperren, damit jeder Mitarbeiter nur seine Kunden sehen kann.
Geht das?
LG und schonmal Danke
Sub MA_Dateien_speichern() Dim strName As String, varOrdner, varDateixlsm, varDateixlsx Dim zeile As Long Dim wkb As Workbook Dim wkbMA As Workbook Set wkb = ActiveWorkbook With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Bitte Ordner für zu erstellende Dateien auswählen/erstellen" If .Show = -1 Then varOrdner = .SelectedItems(1) Else Exit Sub End If End With With wkb.Worksheets(2) 'Kürzel-Liste abarbeiten For zeile = 2 To .Cells(.Rows.Count, 6).End(xlUp).Row 'startzeile ggf. anpassen. strName = .Cells(zeile, 6).Text varDateixlsm = varOrdner & Application.PathSeparator & strName & ".xlsm" varDateixlsx = varOrdner & Application.PathSeparator & strName & ".xlsx" If wkb.FileFormat = 52 Then 'xlOpenXMLTemplateMacroEnabled 'Datei ist Datei mit Makros wkb.SaveCopyAs varDateixlsm Set wkbMA = Application.Workbooks.Open(varDateixlsm) With wkbMA.Worksheets(1) .Range("D2").Value = strName .Calculate .Cells.Locked = True .Protect Password:="Test" End With Application.DisplayAlerts = False wkbMA.SaveAs varDateixlsx, FileFormat:=51 Application.DisplayAlerts = True wkbMA.Close savechanges:=True VBA.Kill varDateixlsm Else 'Datei hat keine Makros wkb.SaveCopyAs varDateixlsx Set wkbMA = Application.Workbooks.Open(varDateixlsx) With wkbMA.Worksheets(1) .Range("D2").Value = strName .Calculate .Cells.Locked = True .Protect Password:="Test" End With wkbMA.Save wkbMA.Close savechanges:=True End If Next End With End Sub
.Cells.Locked = True
Sub MA_Dateien_speichern() Dim strName As String, varOrdner, varDatei, strExt As String Dim zeile As Long Dim wkb As Workbook Dim wkbMA As Workbook Set wkb = ActiveWorkbook strExt = Mid(wkb.Name, InStrRev(wkb.Name, ".")) With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Bitte Ordner für zu erstellende Dateien auswählen/erstellen" If .Show = -1 Then varOrdner = .SelectedItems(1) Else Exit Sub End If End With With wkb.Worksheets(2) 'Kürzel-Liste abarbeiten For zeile = 2 To .Cells(.Rows.Count, 6).End(xlUp).Row 'Startzeile ggf. anpassen. strName = .Cells(zeile, 6).Text varDatei = varOrdner & Application.PathSeparator & strName & strExt wkb.SaveCopyAs varDatei Set wkbMA = Application.Workbooks.Open(varDatei) With wkbMA.Worksheets(1) .Unprotect Password:="Test" 'Wenn Blatt in Mappe per Passwort geschützt ist, sonst _ Passwort weglassen With .Range("D2") .Value = strName .Locked = True End With .Calculate .Protect Password:="Test" End With wkbMA.Close savechanges:=True Next End With End Sub