locked
Como manter formatação de células? RRS feed

  • Pergunta

  • 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

    quarta-feira, 2 de setembro de 2009 10:45

Todas as Respostas

  • 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Á

    domingo, 22 de novembro de 2009 19:13