So da bin ich wieder, habs schon zusammen gebastelt. Jetzt hoffe ich, dass du weisst, wie man ein Modul einfuegt. Ich musste naemlich eine Funktion dazubasteln, die die letzte Zeile im Listobjekt ermittelt.

Also, du fuegst ein Modul ein. In dieses Modul kopierst du folgendes:

Function FindLetzte(rngRange As Range) As Long

Dim LRow As Long, LCol As Long
Dim A As Long
 
With rngRange
On Error Resume Next
    LRow = .Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False, False).Row
    LRow = Application.Max(LRow, .Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row)
    If LRow = 0 Then LRow = 1
    FindLetzte = LRow
End With
 
End Function

Dann ersetzt du meinen alten Code im Button Code mit diesem:

Dim vntPathAndFileNames As Variant 'kein String !
Dim strPathAndFile As String
Dim lngI As Long, LZM As Long, LZZ As Long
Dim wbkMappe As Workbook
Dim wks As Worksheet
Dim wbkZiel As Workbook
Dim oList As ListObject, rngLetzte As Long

Application.ScreenUpdating = False
Set wbkZiel = ThisWorkbook
Set oList = wbkZiel.ActiveSheet.ListObjects(1)
rngLetzte = FindLetzte(oList.Range)
vntPathAndFileNames = Application.GetOpenFilename(FileFilter:="Excel Dateien (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Zu öffnende Datei auswählen", MultiSelect:=False)
  
If VarType(vntPathAndFileNames) = vbBoolean Then
    MsgBox "Abgebrochen!"
Else
    strPathAndFile = vntPathAndFileNames
    Set wbkMappe = Application.Workbooks.Open(strPathAndFile)

    With wbkMappe.ActiveSheet
        LZM = .Cells(Rows.Count, 14).End(xlUp).Row
        LZZ = rngLetzte
        .Range(Cells(2, 14), Cells(LZM, 14)).Copy
        If LZZ <> 2 Then
            wbkZiel.ActiveSheet.Cells(LZZ + 1, 4).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        Else
            wbkZiel.ActiveSheet.Cells(LZZ, 4).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
        LZM = .Cells(Rows.Count, 12).End(xlUp).Row
        .Range(Cells(2, 12), Cells(LZM, 12)).Copy
        If LZZ <> 2 Then
            wbkZiel.ActiveSheet.Cells(LZZ + 1, 2).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        Else
            wbkZiel.ActiveSheet.Cells(LZZ, 2).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
        LZM = .Cells(Rows.Count, 11).End(xlUp).Row
        .Range(Cells(2, 11), Cells(LZM, 11)).Copy
        If LZZ <> 2 Then
            wbkZiel.ActiveSheet.Cells(LZZ + 1, 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        Else
            wbkZiel.ActiveSheet.Cells(LZZ, 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
        LZM = .Cells(Rows.Count, 9).End(xlUp).Row
        .Range(Cells(2, 9), Cells(LZM, 9)).Copy
        If LZZ <> 2 Then
            wbkZiel.ActiveSheet.Cells(LZZ + 1, 7).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        Else
            wbkZiel.ActiveSheet.Cells(LZZ, 7).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    End With
wbkMappe.Close False
End If

Dann solte es wie gewuenscht funktionieren.

Gruss Torsten