Unterstützung Prüfen...

Public Sub Namen_in_Lager_Gesamt_kopieren()
  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 = "Lager_Gesamt.xlsm"
  Const cstr_wksQUELLE As String = "Lager_1"
  Const getStrPassWort = "tk"
  
  Set wkbQUELLE = ActiveWorkbook
  Set wksQUELLE = ActiveSheet
    
  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)
  End If
  'Worksheet-Variable setzen
  Set wksZIEL = wkbZIEL.Worksheets(cstr_wksQUELLE)
  '""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    Dim lFile
    Dim lloRow As Long, ldtRgDate As Date, lstrRgNr As String, lboOK As Boolean, lloRNext As Long
    Dim wks, shs, pshDB
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
             
 wkbZIEL.Activate
 
 wkbQUELLE.Activate
  
  'Suchergebnis prüfen: strSUCH nicht gefunden: Am Ende Anfügen
  If rngZIEL Is Nothing Then
    Set rngZIEL = wksZIEL.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)   'Offset(1, 0  = 1 zeile drunter
  End If
  
  ' jetzt übertragen
  wksZIEL.Unprotect "tk"                 '(getStrPassWort)
  wksQUELLE.Range("K11:K21").Copy
   rngZIEL.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  wksZIEL.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=getStrPassWort
  Application.CutCopyMode = False
  wkbQUELLE.Activate        'Datei
  wksQUELLE.Activate        'Sheet
  wksQUELLE.Range("K12").Select
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub