Ich verzweifle an folgendem Problem:
Ich habe mehrere identisch aufgebaute Team-Arbeitsmappen mit 3 festen Blättern (Kataloge, Blanko-Vorlage und "Startseite")und x Blättern, die jeweils einen Mitarbeiter beinhalten. Die Mitarbeiter haben in einigen Zellbereichen eine Datenprüfung, die sich auf Listen im Kataloge-Blatt bezieht. Die Datenüberprüfung wird per VBA im Worbook open für alle Mitarbeiterblätter gesetzt.
Nun kann ich mit folgendem Code einen Mitarbeiter zu einem anderen Team (in eine andere Mappe) _ verschieben:
Option Explicit
Sub MA_verschieben()
Dim strOrdner As String, strDateiname As String
Dim wbZiel As Workbook
Dim wbQuelle As Workbook
Dim wsQuelle As Worksheet
Dim Team As String
Call Datenüberprüfung_loeschen "" Then
'Mappe aus o.g. Ordner öffnen :
Set wbZiel = Workbooks.Open(strOrdner & strDateiname, UpdateLinks:=False)
wsQuelle.Activate
ActiveSheet.Move After:=Workbooks(Team & ".xlsm").Sheets("Start")
Else
MsgBox "Folgende Datei existiert nicht : " & vbLf & vbLf & _
strOrdner & strDateiname, vbOKOnly + vbCritical, "Datei nicht gefunden !"
End If
End If
End If
wbZiel.Close SaveChanges:=True
'Speicher für Objektvariable freigeben :
Set wbZiel = Nothing
Set wbQuelle = Nothing
Set wsQuelle = Nothing
End Sub
Leider gelingt es mir ums Verrecken nicht, die Datenprüfung vorher zu entfernen, so dass der Bezug zum alten Team/zur Quellmappe bestehen bleibt und ich den alten Bezug über den Namensmanager manuell immer wieder entfernen muss.Die restlichen Formatierungen müssen erhalten bleiben.
Ich versuche es bisher so:
Sub Datenüberprüfung_loeschen()
Blattschutz_aus
With Range("M6,C12,C13,C14").Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Blattschutz_ein
End Sub
Einzeln aufgerufen funktioniert es. In Kombination mit dem "Sub MA_verschieben()" aber nicht. Hat jemand eine Idee dazu?
Vielen Dank vorab
Vic