Excel VBA Kopieren mit Format

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim intRow, lngSpalte
If Target.Address = "$A$2" Then
Cells(2, 2) = "Nichts Ausgewählt"
ElseIf Target.Address = "$B$2" Then
If Cells(2, 2)  "Nichts Ausgewählt" Then
With Sheets("Auswahl")
intRow = 2
'Zeilen hochzählen, bis zur 1. leeren Zeile in E:M
Do
'prüfen, ob Zellen in Spalten E bis M der Zeile leer sind
If Application.WorksheetFunction.CountA(.Range(.Cells(intRow, 5), _
.Cells(intRow, 14))) = 0 Then
If intRow > 2 Then
Application.EnableEvents = False
'Inhalte und Formate im Bereich E2:Mxxx löschen
.Range(.Cells(2, 5), .Cells(intRow - 1, 14)).Clear
Application.EnableEvents = True
End If
Exit Do
End If
intRow = intRow + 1
Loop
End With
For intRow = 1 To 300
If Target.Value = Worksheets("DP").Cells(intRow, 1).Value Then
With Sheets("DP")
If .Cells(intRow, 1).MergeCells = True Then 'Zellen in Spalte A _
sind verbunden
.Range(.Cells(intRow, 2), .Cells(intRow + _
.Cells(intRow, 1).MergeArea.Rows.Count - 1, 10)).Copy
Else
.Range(.Cells(intRow, 2), .Cells(intRow, 10)).Copy
End If
End With
Worksheets("DP").Range(Worksheets("DP").Cells(intRow, 2), Worksheets("DP").Cells(intRow, 10)). _
Copy Worksheets("Auswahl").Range(Worksheets("Auswahl").Cells(2, 5), Worksheets("Auswahl").Cells(2, 13))
Exit For
End If
Next intRow
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim intRow, lngSpalte
If Target.Address = "$A$2" Then
Cells(2, 2) = "Nichts Ausgewählt"
ElseIf Target.Address = "$B$2" Then
If Cells(2, 2)  "Nichts Ausgewählt" Then
With Sheets("Auswahl")
intRow = 2
'Zeilen hochzählen, bis zur 1. leeren Zeile in E:M
Do
'prüfen, ob Zellen in Spalten E bis M der Zeile leer sind
If Application.WorksheetFunction.CountA(.Range(.Cells(intRow, 5), _
.Cells(intRow, 14))) = 0 Then
If intRow > 2 Then
Application.EnableEvents = False
'Inhalte und Formate im Bereich E2:Mxxx löschen
.Range(.Cells(2, 5), .Cells(intRow - 1, 14)).Clear
Application.EnableEvents = True
End If
Exit Do
End If
intRow = intRow + 1
Loop
End With
For intRow = 1 To 100
If Target.Value = Worksheets("DP").Cells(intRow, 1).Value Then
With Sheets("DP")
If .Cells(intRow, 1).MergeCells = True Then 'Zellen in Spalte A _
sind verbunden
.Range(.Cells(intRow, 2), .Cells(intRow + _
.Cells(intRow, 1).MergeArea.Rows.Count - 1, 10)).Copy
Else
.Range(.Cells(intRow, 2), .Cells(intRow, 10)).Copy
End If
End With
With Sheets("Auswahl")
Application.EnableEvents = False
.Cells(Target.Row, 5).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(Target.Row, 5).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.EnableEvents = True
End With
Exit For
End If
Next intRow
End If
End If
End Sub