Hallo Liebe Excel Experten,

unter dem folgenden Link findet ihr mein aktuelles Projekt.
Die Erfassung aktueller Aufträge in einer Auftragsliste.
Mein Problem ist, wenn ich eine Auftragsnummer bearbeite und dieser Inhalt gebe und diesen über eine UserForm an die Tabelle übergebe,
so wird die aktuelle Formartierung in der Tabelle überschrieben.

Meine Frage ist:
Wie kann ich dem aktiven Datensatz bei Übergabe der Daten an die Tabelle, die Formartierung der Tabelle übergeben.
Heißt wenn "A1" eine Schriftformartierung von "Bariol Regular, Schriftgröße: 12" hat soll "A2" nach Übergabe der Daten aus der UserForm
die gleiche Formartierung wie "A1" haben.

Link: auftragsliste-2

Aktueller Code zur Übergabe der Daten an die Tabelle so wie den Versuch die Formartierungen zu übernehmen:

Sub programmedit()
    Dim intSpalte As Integer
    Dim ctrTB As Control
    Dim rngSucheTeil As Range
    
    If uf_programm.tx_ocno.Value <> "" Then
        With Tabelle2
            Set rngSucheTeil = .Columns("A:Q").Find(uf_programm.tx_ocno, LookAt:=xlWhole, LookIn:=xlValues)
            If Not rngSucheTeil Is Nothing Then
                ' Schleife über alle Steuerelemente
                For Each ctrTB In uf_programm.Controls
                ' Tag-Eigenschaft ist nicht leer
                If ctrTB.Tag <> "" Then
                    ' in Zelle(gefundeneZeile, Spaltennummer aus Tag-Eigenschaft) aus Steuerelement übergeben
                    .Cells(rngSucheTeil.Row, Int(ctrTB.Tag)).Value = ctrTB
                End If
              Next ctrTB
              
              Run "MachMal"
          Else
              MsgBox "Die Daten von """ & uf_programm.tx_ocno & """  wurden nicht gefunden!", 48, _
                  "   Hinweis für " & Application.UserName
              uf_programm.tx_ocno.SetFocus
                End If
            End With
        Set rngSucheTeil = Nothing
     End If
End Sub

Sub MachMal()
Dim ws As Worksheet, rg1 As Range, rg2 As Range
Dim n As Long

'hier den Tabellennamen anpassen
Set ws = ThisWorkbook.Worksheets("Tabelle2")

With ws
    'Überschriften-Bereich definieren
    Set rg1 = .Range("A3:Q3")
    'neu zu formatierender Bereich mit Überschriften-Zellen
    Set rg2 = .UsedRange
    'zu formatierender Bereich ohne Überschriften-Zellen
    Set rg2 = rg2.Offset(2).Resize(rg2.Rows.Count - 1)
End With
'Überschriften kopieren
rg1.Copy
'Format übertragen
rg2.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

'Kopierbereich deaktivieren
Application.CutCopyMode = False

'Markierung der formatierten Zellen deaktivieren
rg2.Cells(1, 1).Select

'Objektvariablen zerstören
Set rg1 = Nothing
Set rg2 = Nothing
Set ws = Nothing
End Sub

Vielen Dank im Voraus für eure Hilfe.

Gruß

Marius