Duplikate aus Datei erstellen benennen und sperren

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Blume,
hier ein Makro-Beispiel.
LG
Franz

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

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

Beliebteste Forumthreads (12 Monate)

Duplikate aus Datei erstellen benennen und sperren

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Duplikate aus Datei erstellen benennen und sperren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread