Copy bold setting to other column

[Romano_odK]

Good afternoon,

In the code below I would like to copy the bold value to the other column. Is that possible?

Thank you for your time.

Private Sub CopyToVerkoopprijs_Click()
Worksheets("items").ListObjects("itemsimport").ListColumns(7).DataBodyRange.Font.Bold = True

Dim DRng As Range, CRng As Range
Dim DArr As Variant, CArr As Variant
With Sheets("Items")
        Set CRng = .Range(.ListObjects("ItemsImport").ListColumns(6).DataBodyRange.Address) 'Create write Range
        Set DRng = .Range(.ListObjects("ItemsImport").ListColumns(7).DataBodyRange.Address) 'Create read Range
               
        CArr = CRng.Value ' range to array
        DArr = DRng.Value ' range to array

        For i = LBound(CArr, 1) To UBound(CArr, 1)
            If Len(DArr(i, 1)) > 0 Then CArr(i, 1) = DArr(i, 1) ' if cell has more then 0 characters
        Next i

End With
CRng.Value = CArr ' Write values back to table
Worksheets("items").ListObjects("itemsimport").ListColumns(7).DataBodyRange.Font.Bold = False
'Range("H6:K15000").ClearContents

End Sub