VBA beim Kopieren werden Formatierungen nicht übernommen

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim wsCodes As Worksheet

    Set wsCodes = ThisWorkbook.Sheets("Codes") ' Blatt "Codes" setzen

    

    ' Prüfen, ob die Änderung in genau einer Zelle der Spalte G erfolgt ist

    If Not Target Is Nothing And Target.Count = 1 Then

        If Target.Column = 7 Then ' Spalte G entspricht Spalte 7

            Application.ScreenUpdating = False ' Bildschirmaktualisierung ausschalten

            Application.Calculation = xlCalculationManual ' Manuelle Berechnung zur Optimierung

            Application.EnableEvents = False ' Ereignisse deaktivieren, um Rekursion zu vermeiden



            ' Schritt 1: Formatierung der geänderten Zelle in Spalte E und der benachbarten Zelle in Spalte D

            With Target

                .HorizontalAlignment = xlCenter

                .Font.Italic = True

                .Font.Bold = False

                .Font.Size = 11

            End With

            

            If Not IsEmpty(Target.Offset(0, -3)) Then

                With Target.Offset(0, -3)

                    .HorizontalAlignment = xlCenter

                    .Font.Italic = True

                End With

            End If

            

            ' Schritt 2: Text in Spalte G bis zur letzten Zeile in Spalte A kopieren

            Dim lastRow As Long

            lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row

            

            Dim i As Long

            For i = Target.Row To lastRow

                ' Kopieren der gesamten Zelle (Wert und Formatierung)

                Target.Copy

                Me.Cells(i, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

            Next i



            ' Schritt 3: Spaltenbreiten für A bis G automatisch anpassen

            Me.Columns("A:G").AutoFit



            ' Schritt 5: Löschen der markierten Zeilen im Blatt "Codes"

            wsCodes.Activate

            With wsCodes

                If TypeName(Selection) = "Range" Then

                    Dim selectedRange As Range

                    Set selectedRange = Selection

                    

                    ' Löschen der markierten Zeilen im Blatt "Codes"

                    selectedRange.EntireRow.Delete

                Else

                    MsgBox "Bitte wählen Sie eine gültige Zellenauswahl.", vbExclamation

                End If

            End With

            

            ' Standard-Einstellungen wiederherstellen

            Application.EnableEvents = True

            Application.Calculation = xlCalculationAutomatic

            Application.ScreenUpdating = True

        End If

    End If

End Sub