Sub Beipackliste()
Dim loLetzte As Long
Dim strDatei As String
Workbooks.Open Filename:="K:\EDV\Filstamm\Filiale_VC_Tour_Fahrer.xls"
With Range("A1:A4000")
.NumberFormat = "General"
.Value = .Value
End With
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(15, 2), .Cells(loLetzte, 2)).Formula = _
"=VLOOKUP(A15,'K:\EDV\Filstamm\[new_all_fil.xlsx]Sheet'!$A:B,2,FALSE)"
.Range(.Cells(15, 2), .Cells(loLetzte, 2)).Value = .Range(.Cells(15, 2), .Cells(loLetzte, 2)).Value
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(15, 3), .Cells(loLetzte, 3)).Formula = _
"=VLOOKUP(A15,'K:\EDV\Filstamm\[Filiale_VC_Tour_Fahrer.xls]Filiale_VC_Tour_Fahrer'!$A:B,2,FALSE)"
.Range(.Cells(15, 3), .Cells(loLetzte, 3)).Value = .Range(.Cells(15, 3), .Cells(loLetzte, 3)).Value
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(15, 4), .Cells(loLetzte, 4)).Formula = _
"=VLOOKUP(A15,'K:\EDV\Filstamm\[Filiale_VC_Tour_Fahrer.xls]Filiale_VC_Tour_Fahrer'!$A:C,3,FALSE)"
.Range(.Cells(15, 4), .Cells(loLetzte, 4)).Value = .Range(.Cells(15, 4), .Cells(loLetzte, 4)).Value
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(15, 5), .Cells(loLetzte, 5)).Formula = _
"=VLOOKUP(A15,'K:\EDV\Filstamm\[Filiale_VC_Tour_Fahrer.xls]Filiale_VC_Tour_Fahrer'!$A:D,4,FALSE)"
.Range(.Cells(15, 5), .Cells(loLetzte, 5)).Value = .Range(.Cells(15, 5), .Cells(loLetzte, 5)).Value
End With
Workbooks("Filiale_VC_Tour_Fahrer.xls").Close savechanges:=False
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range _
("C15:C32"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range _
("D15:D32"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range _
("E15:E32"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A14:H32")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With Sheets("Tabelle1")
Range("C200").Select
Selection.End(xlUp).Select
Do Until ActiveCell = "VC02"
ActiveCell.Offset(-1, 0).Range("A1").Select
Loop
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell.Offset(-1, 0)
End With
ActiveWorkbook.Worksheets(1).Copy
Application.Dialogs(xlDialogSaveAs).Show ActiveSheet.Name
End Sub