Hallo liebes Forum,
ich hab ein kleines Excelproblem, bei dem ihr mir hoffentlich helfen könnt.
Ich habe eine Exceldatei (Basis), die mit einer zweiten Datei (Monat) verknüpft ist. In der Datei Basis gibt es eine Zelle in der, der entsprechende Monat ausgewählt wird, dadurch wird das Makro unten ausgelöst.

Das Problem auf Windows XP läuft das ganze in 3 Minuten ab und die Datei ist umgestellt.

In der Firma wird Windows 7 mit entsprechendem Excel 2010 und neuen PCs benutzt . Hier braucht das Makro geschlagene 1,5 Std !!! bis die Änderung durchgeführt wird.

Hab ich einen Fehler im Makro oder gibt es einen neuen Befehl, der die Verlinkung ändert und schneller ist???

Hoffe ihr könnt mir helfen.

Vielen Dank

Vindariel


Private Sub Worksheet_Change(ByVal Target As Range)

With Target

Select Case .Address

Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="xxxxx"


Case Is = "$P$1", "$S$1" ' in P steht der Monat in S das Jahr

Dim neuerLink
y = MsgBox("Es wird auf den gewählten Monat umgeschaltet. Bitte OK anklicken. Dieser Vorgang dauert ca. 3 MINUTEN!!! BITTE WARTEN!!!", vbCritical, "W I C H T I G ! ! ! ")
Application.ScreenUpdating = False
Sheets("Stammdaten").Select
ActiveSheet.Unprotect Password:="xxxxx"
Select Case Sheets("Einteilung").Range("P1").Value

Case 1
Sheets("Stammdaten").Range("BN10").Value = ActiveWorkbook.LinkSources 'aktuelle Verlinkung
neuerLink = Sheets("Stammdaten").Range("BN6").Value & Sheets("Stammdaten").Range("BN7").Value _
& " Januar " & Sheets("Stammdaten").Range("BR3").Value & ".xls" 'Zusammensetzung des neuen Pfades und Dateinamen
If Dir(neuerLink) <> "" Then

'Überprüfung ob die neue Datei, auf die verlinkt wird, existiert, wenn ja wird der Link gewechselt ansonsten Abbruch durch Else

ActiveWorkbook.ChangeLink Name:=Sheets("Stammdaten").Range("BN10").Value, _
newname:=Sheets("Stammdaten").Range("BN6").Value & Sheets("Stammdaten").Range("BN7").Value _
& " Januar " & Sheets("Stammdaten").Range("BR3").Value & ".xls", Type:=xlLinkTypeExcelLinks
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxxxx"
Sheets("Einteilung").Select
Application.ScreenUpdating = True
y = MsgBox("auf Januar umgeschaltet.")
Else:
y = MsgBox("Monatdatei Januar " & Sheets("Stammdaten").Range("BR3").Value & ".xls existiert noch nicht bitte anlegen")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxxxx"
Sheets("Einteilung").Select
Application.ScreenUpdating = True
End If

Case 2 'Case 2 bis 12 sind identisch mit Case 1 nur mit den anderen Monatsnamen

End Select

End Select
End With
End Sub