Dim vntPathAndFileNames As Variant
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