Como manter formatação de células?

Question

Bom dia,
Estou a tentar criar um formulário em Excel, que transfere os valores inseridos na linha 5 da Folha1 para a Folha 2.
Estou a utilizar a seguinte forma:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Testar se foi introduzido um valor na coluna D
    If Target.Column = 4 Then
        'Testar se o valor inserido é uma data
        If IsDate(Target.Value) Then
        'Determinar a linha da planilha Base2 que receberá as informações de Base1
        InsertRow = Plan2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        'Mover o intervalo da coluna A até a coluna D de Base1 para a primeira
        'célula vazia da coluna A de Base2
        Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Cut Plan2.Cells(InsertRow, 1)
        End If
    End If
End Sub

Só que as formatações das células da Folha1 são também transferidas para a Folha2 e o que eu pretendia era manter todas as formatações na Folha1, transferindo somente para a Folha2 os valores (texto, horas e números).
Será que existe alguma forma de fazer isso ?
Obrigado.

[]s

Answer 1

Caro Alexandre,

Inseri algumas linhas e modifiquei outras. Teste:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim insertrow As Integer

    'Testar se foi introduzido um valor na coluna D
    If Target.Column = 4 Then
        'Testar se o valor inserido é uma data
        If IsDate(Target.Value) Then
            'Determinar a linha da planilha Base2 que receberá as informações de Base1
            insertrow = Plan2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            'Mover o intervalo da coluna A até a coluna D de Base1 para a primeira
            'célula vazia da coluna A de Base2
            Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Select
            'Por enquanto vamos só copiar os dados
            Selection.Copy
            Sheets("Plan2").Select
            Plan2.Range("A" & insertrow).Select
            'colando apenas o que nos interessa:
            Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
                                   xlNone, SkipBlanks:=False, Transpose:=False
            'Faxina no Clipboard:
            Application.CutCopyMode = False
            'Agora sim, vamos apagar o conteúdo de Plan1:
            Sheets("Plan1").Select
            Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Select
            Selection.ClearContents
        End If
    End If
End Sub

ALeXceL
BeAgÁ