VBA вставить значения листа1 и сохранить исходный цвет источника, но не шрифт и другие форматы ...?

Question

У меня до 6 ячеек с потенциальными данными из 6 разных мест. Я пытаюсь получить только первые три ячейки с данными, перенесенными на другой лист С ОРИГИНАЛЬНЫМ ЦВЕТОМ ЛИСТА 1, но без ФОРМАТА

 Sub Transfer_Data()


Dim i As Long, j As Long

j = 1

For i = 1 To 6
    If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
        Sheets("Sheet2").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
        j = j + 1
    End If

If j > 3 Then Exit For
Next i

End Sub

Что происходит, когда он пытается сохранить sheet1, он отображает формат листа2 и его цвет. Я попробовал это также, но его хранение Sheet1 форматов .....

Sub Transfer_Data()

Dim i As Long, j As Long

j = 1

For i = 1 To 6
    If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
        Sheets("Sheet1").Cells(i, 1).Copy
        Sheets("Sheet2").Cells(j, 1).PasteSpecial xlPasteFormats
        Sheets("Sheet2").Cells(j, 1).PasteSpecial xlPasteValues
        j = j + 1
    End If

If j > 3 Then Exit For
Next i
Application.CutCopyMode = False
End Sub

Answer 1

VBA также может применить форматирование к ячейке:

Sub Transfer_Data()


Dim i As Long, j As Long

j = 1

For i = 1 To 6
    If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
        Sheets("Sheet2").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
        Sheets("Sheet2").Cells(j, 1).Font.Color = Sheets("Sheet1").Cells(i, 1).Font.Color
        j = j + 1
    End If

If j > 3 Then Exit For
Next i

End Sub

Обратите внимание, что это будет работать, только если весь текст в данной ячейке имеет одинаковый цвет