.PasteSpecial Paste:=xlFormats funktioniert nicht

Sub Datenimport()
Dim c_TabN As String, d_TabN As String, e_TabN As String
Dim c_lr As String, d_lr As String, e_lr As String
Dim c_lrZiel As String, d_lrZiel As String, e_lrZiel As String
Dim c_ID_qFile As String, d_ID_qFile As String, e_ID_qFile As String
Dim c_SpNr As Long, d_SpNr As Long, e_SpNr As Long
Dim c_SpID As Long, d_SpID As Long, e_SpID As Long
Dim c_AnzID As Long, d_AnzID As Long, e_AnzID As Long
Dim c_Item2 As Long, d_item2 As Long, e_item2 As Long
Dim strVerz As String, strDatei As String, lngZ As Long, i As Long
Dim ThisWB As Workbook, QuellWB As Workbook
Dim ShTab As Worksheet, c_ZTab As Worksheet, d_ZTab As Worksheet, e_ZTab As Worksheet
Set ThisWB = ActiveWorkbook
Set c_ZTab = ThisWB.Sheets("C")
Set d_ZTab = ThisWB.Sheets("D")
Set e_ZTab = ThisWB.Sheets("E")
Set ShTab = ThisWB.Sheets("Dateien")
c_TabN = Range("_c_Tab_Q").value
c_SpNr = SpNr(Range("_c_Spa_Zd").value)
c_SpID = SpNr(Range("_c_Spa_Id").value)
c_AnzID = Range("_c_Anz_Id").value
c_Item2 = Range("_c_It_2").value
d_TabN = Range("_d_Tab_Q").value
d_SpNr = SpNr(Range("_d_Spa_Zd").value)
d_SpID = SpNr(Range("_d_Spa_Id").value)
d_AnzID = Range("_d_Anz_Id").value
d_item2 = Range("_d_It_2").value
e_TabN = Range("_e_Tab_Q").value
e_SpNr = SpNr(Range("_e_Spa_Zd").value)
e_SpID = SpNr(Range("_e_Spa_Id").value)
e_AnzID = Range("_e_Anz_Id").value
e_item2 = Range("_e_It_2").value
''Quell-Verzeichnis
strVerz = ThisWB.Path & "\" 'Backslash am Ende nicht vergessen!
ShTab.Columns(1).ClearContents  '' Liste importierter Daten löschen
'' Inhalte der Worksheets C-X löschen
c_ZTab.Cells.ClearContents: d_ZTab.Cells.ClearContents: e_ZTab.Cells.ClearContents
Application.ScreenUpdating = False
'Verzeichnis auslesen
strDatei = Dir(strVerz & "*.xlsm")
'Debug.Print strDatei
Do Until strDatei = ""
If UCase(strVerz & strDatei)  UCase(ActiveWorkbook.FullName) Then
lngZ = lngZ + 1
ShTab.Cells(lngZ, 1) = strDatei
End If
strDatei = Dir()
Loop
'Dateien nacheinander öffnen und Daten übertragen
For i = 1 To lngZ
Set QuellWB = Workbooks.Open(Filename:=strVerz & ShTab.Cells(i, 1))
c_lr = QuellWB.Worksheets(c_TabN).Cells(Rows.Count, c_SpNr).End(xlUp).Row
d_lr = QuellWB.Worksheets(d_TabN).Cells(Rows.Count, d_SpNr).End(xlUp).Row
e_lr = QuellWB.Worksheets(e_TabN).Cells(Rows.Count, e_SpNr).End(xlUp).Row
c_ID_qFile = Left(QuellWB.Name, c_AnzID)
d_ID_qFile = Left(QuellWB.Name, d_AnzID)
e_ID_qFile = Left(QuellWB.Name, e_AnzID)
''Tabelle C   '''  'Wenn Spalte nicht leer dann...
If c_lr > 0 Then
c_lrZiel = c_ZTab.Cells(c_ZTab.Rows.Count, c_SpNr).End(xlUp).Row + 1
Select Case i
Case 1
QuellWB.Worksheets(c_TabN).Range(QuellWB.Worksheets(c_TabN).Cells(1, c_SpID),  _
QuellWB.Worksheets(c_TabN).Cells(c_lr, c_SpID)) = c_ID_qFile
QuellWB.Worksheets(c_TabN).Rows("1:" & c_lr).Copy
With c_ZTab.Rows(c_lrZiel - 1)
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats: End With
Application.CutCopyMode = False
Case Else
QuellWB.Worksheets(c_TabN).Range(QuellWB.Worksheets(c_TabN).Cells(1, c_SpID),  _
QuellWB.Worksheets(c_TabN).Cells(c_lr, c_SpID)) = c_ID_qFile
QuellWB.Worksheets(c_TabN).Rows(c_Item2 & ":" & c_lr).Copy
With c_ZTab.Rows(c_lrZiel)
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
End Select
End If
''Tabelle D
If d_lr > 0 Then
d_lrZiel = d_ZTab.Cells(d_ZTab.Rows.Count, d_SpNr).End(xlUp).Row + 1
Select Case i
Case 1
QuellWB.Worksheets(d_TabN).Range(QuellWB.Worksheets(d_TabN).Cells(1, d_SpID),  _
QuellWB.Worksheets(d_TabN).Cells(d_lr, d_SpID)) = d_ID_qFile
QuellWB.Worksheets(d_TabN).Rows("1:" & d_lr).Copy
With d_ZTab.Rows(d_lrZiel - 1)
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
Case Else
QuellWB.Worksheets(d_TabN).Range(QuellWB.Worksheets(d_TabN).Cells(1, d_SpID),  _
QuellWB.Worksheets(d_TabN).Cells(d_lr, d_SpID)) = d_ID_qFile
QuellWB.Worksheets(d_TabN).Rows(d_item2 & ":" & d_lr).Copy
With d_ZTab.Rows(d_lrZiel):
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
End Select
End If
''Tabelle E
If e_lr > 0 Then
e_lrZiel = e_ZTab.Cells(e_ZTab.Rows.Count, e_SpNr).End(xlUp).Row + 1
Select Case i
Case 1
QuellWB.Worksheets(e_TabN).Range(QuellWB.Worksheets(e_TabN).Cells(1, e_SpID),  _
QuellWB.Worksheets(e_TabN).Cells(e_lr, e_SpID)) = e_ID_qFile
QuellWB.Worksheets(e_TabN).Rows("1:" & e_lr).Copy
With e_ZTab.Rows(e_lrZiel - 1)
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
Case Else
QuellWB.Worksheets(e_TabN).Range(QuellWB.Worksheets(e_TabN).Cells(1, e_SpID),  _
QuellWB.Worksheets(e_TabN).Cells(e_lr, e_SpID)) = e_ID_qFile
QuellWB.Worksheets(e_TabN).Rows(e_item2 & ":" & e_lr).Copy
With e_ZTab.Rows(e_lrZiel)
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
End With
Application.CutCopyMode = False
End Select
End If
QuellWB.Close False  'Mappe (ohne speichern) schließen
Next i
Application.ScreenUpdating = True
End Sub