Speicherung klappt nicht

Public Sub Adresse_einsetzen_holen()
Dim wksQUELLE As Worksheet            'Quell-Worksheet
Dim wksZIEL As Worksheet                  'Ziel-Worksheet
Dim wkbZIEL As Workbook, wkbQUELLE As Workbook
Dim rngZIEL As Range
Dim strSUCH As String
Const cstr_wkbQUELLE As String = "#_Datenbank.xlsm"
Const cstr_wksQUELLE As String = "Adressen"
Const getStrPassWort = "ww"
Set wkbQUELLE = ActiveWorkbook
Set wksQUELLE = ActiveSheet
Application.ScreenUpdating = False
On Error Resume Next
Set wkbZIEL = Workbooks(cstr_wkbQUELLE)
On Error GoTo 0
If wkbZIEL Is Nothing Then
Set wkbZIEL = Workbooks.Open("D:\" & cstr_wkbQUELLE)
Else
wkbZIEL.Activate
End If
Set wkbZIEL = Workbooks.Open("D:\#_Datenbank.xlsm")
ActiveSheet.Range("B2").Select
Application.Run "'#_Datenbank.xlsm'!StartUF"
Application.ScreenUpdating = True
Set wkbQUELLE = Nothing
Set wksQUELLE = Nothing
'   wkbZIEL.Close True
End Sub