Hyperlinks in andere Datei kopieren

Sub Datenexport()
'Daten aus zwei Tabellen abgleichen per Schlüsselspalte
Dim wbQuelle As Workbook, wksQuelle As Worksheet, vAuswahl
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long
Dim Zelle As Range, rBereich As Range
Dim ZeileQuelle As Long, ZeileZiel As Long
Set wbZiel = Workbooks("Widerspruchsdatei 2014 02.xlsm")
Set wksZiel = wbZiel.Worksheets("Widersprüche") 'Name - anpassen
'Nr. der Schlüsselspalte in Zieldatei
lSpalteSchluessel = 13 'ggf Anpassen
With wksZiel
'Letzte Datenzeile in Zieltabelle Spalet
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
'Beich mit ID-Nummern im Zielblatt
Set rBereich = .Range(.Cells(2, lSpalteSchluessel), .Cells(ZeileZiel, lSpalteSchluessel))
End With
'Tabelle mit ggf. neuen Daten
Set wbQuelle = ActiveWorkbook 'Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets("Tabelle")
Application.ScreenUpdating = False
With wksQuelle
lSpalteSchluessel = 3 'Spalte mit ID-Code in Quelldatei
For ZeileQuelle = 4 To .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
'Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(ZeileQuelle, lSpalteSchluessel)
'Name in Bereich mit ID-Code in Zieltabelle suchen
Set Zelle = rBereich.Find(what:=varSchluessel, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then 'Code in Zieldatei nicht vorhanden
'          ZeileZiel = Zelle.Row
Dim LoLetzte As Long
With Workbooks("Widerspruchsdatei 2014 02.xlsm").Worksheets("Widersprüche")
ZeileZiel = .Cells(.Rows.Count, 11).End(xlUp).Row + 1
LetzteZeile = Workbooks("Widerspruchsdatei 2014 02.xlsm").Sheets("Widersprüche"). _
UsedRange.SpecialCells(xlLastCell).Row
End With
wksZiel.Cells(ZeileZiel, 11) = .Cells(ZeileQuelle, 1)
wksZiel.Cells(ZeileZiel, 12) = .Cells(ZeileQuelle, 2)
wksZiel.Cells(ZeileZiel, 13) = .Cells(ZeileQuelle, 3)
wksZiel.Cells(ZeileZiel, 17) = .Cells(ZeileQuelle, 4)
wksZiel.Cells(ZeileZiel, 18) = .Cells(ZeileQuelle, 5)
wksZiel.Cells(ZeileZiel, 24) = .Cells(ZeileQuelle, 6)
wksZiel.Cells(ZeileZiel, 25) = .Cells(ZeileQuelle, 7)
wksZiel.Cells(ZeileZiel, 39) = .Cells(ZeileQuelle, 12)
Else
'MsgBox "Nichts zu exportieren bzw. fertig!"
End If
Next
End With
'Quelldatei wieder schließen
'wbQuelle.Close savechanges:=False
Application.ScreenUpdating = True
MsgBox "Fertig!", vbInformation + vbOKOnly, "Datenabgleich"
Beenden:
Set wbQuelle = Nothing: Set wbZiel = Nothing: Set wksQuelle = Nothing: Set wksZiel =  _
Nothing
Set Zelle = Nothing: Set rBereich = Nothing
End Sub