|  
                                             
	Hallo, 
	um die zusätzlichen Inhalte kopieren zu können muss die Sub ausgetauscht werden: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim strFilename As String
    Dim strValue As String
    Dim wbk As Workbook
    Dim rng As Range
    Set rng = refersToRange("Buttons")
    If Not Intersect(rng, Target) Is Nothing Then
        strFilename = ThisWorkbook.Path & "\autoFile_2.xlsm"
        Set wbk = GetWorkbook(strFilename)
        If wbk Is Nothing Then
            Set wbk = Application.Workbooks.Open(filename:=strFilename)
        Else
            wbk.Activate
        End If
        
        ' B18 <- A3:A502
        strValue = Target.Cells(1, 1).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B18").Value = strValue
        End If
        
        ' B11 <- E3:E502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=4).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B11").Value = strValue
        End If
        
        ' B12 <- F3:F502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=5).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B12").Value = strValue
        End If
        
        ' G10 <- G3:G502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=6).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("G10").Value = strValue
        End If
        
        ' B9 <- H3:H502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=7).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("B9").Value = strValue
        End If
        
        ' --> Weitere zu kopierende Inhalte müssen hier eingesetzt werden <--
    End If
End Sub
	Bei Bedarf muss wieder der Pfad  und Dateiname zu der nachzuladenden Arbeitsmappe angepasst werden. 
	Falls noch weitere Inhalte nach dem gleichen Muster in eine andere Zelle der nachzuladenden Arbeitsmappe kopiert werden sollen, müssen lediglich die nachstehenden Zeilen angepast und unter die bestehenden Zeilen hinzugefügt werden: 
	Bsp: Inhalte der Zeilen K3-K502 sollen in die Zelle H3 kopiert werden: 
        ' H3 <- K3:K502
        strValue = Target.Cells(1, 1).Offset(columnOffset:=10).Value
        If Not strValue = "" Then
            wbk.Worksheets(1).Range("H3").Value = strValue
        End If
	LG, BigBen 
     |