Olá. Eu estou precisando inserir um comentário numa célula a partir do conteúdo de uma outra célula.
Estou usando este código abaixo para fazer as transcrições. Porém gostaria de que na última transcrição o conteúdo da célula W, da aba PORTFÓLIO, virasse o comentário da célula AB da aba PROSPECÇÃO.
Eu encontrei um código que faz isso, mas não consegui adaptar na minha FOR.
Meu código:
Sub definir_contatos()
Plan1.Select
Plan1.Range("c4:o53").ClearContents
Plan1.Range("q4:ab53").ClearContents
Sheet2.Select
Z = 4
For i = 1 To 200
If Sheet2.Range("e" & i) = "o" Then
Plan1.Range("F" & Z) = Sheet2.Range("B" & i)
Plan1.Range("G" & Z) = Sheet2.Range("C" & i)
Plan1.Range("H" & Z) = Sheet2.Range("D" & i)
Plan1.Range("I" & Z) = Sheet2.Range("H" & i)
Plan1.Range("J" & Z) = Sheet2.Range("I" & i)
Plan1.Range("K" & Z) = Sheet2.Range("J" & i)
Plan1.Range("L" & Z) = Sheet2.Range("K" & i)
Plan1.Range("M" & Z) = Sheet2.Range("L" & i)
Plan1.Range("N" & Z) = Sheet2.Range("M" & i)
Plan1.Range("O" & Z) = Sheet2.Range("N" & i)
Plan1.Range("Q" & Z) = Sheet2.Range("O" & i)
Plan1.Range("R" & Z) = Sheet2.Range("P" & i)
Plan1.Range("S" & Z) = Sheet2.Range("Q" & i)
Plan1.Range("T" & Z) = Sheet2.Range("R" & i)
Plan1.Range("U" & Z) = Sheet2.Range("S" & i)
Plan1.Range("V" & Z) = Sheet2.Range("T" & i)
Plan1.Range("W" & Z) = Sheet2.Range("U" & i)
Plan1.Range("AB" & Z) = Sheet2.Range("W" & i) 'aqui é onde preciso fazer este procedimento.
Z = Z + 1
End If
Next
Plan1.Select
Range("b2").Select
End Sub
Abaixo o código que encontrei na internet, mas que não consegui migrar:
Dim sTexto As String
'recolhe o texto da celula A1
sTexto = Sheet2.Range("W" & i)
'só avança caso haja conteudo para o comentário
If Len(sTexto) = 0 Then Exit Sub
'usar a celula activa
With ActiveCell
'evita erros ao eliminar ou adicionar o comentário
On Error Resume Next
'eliminar comentário caso exista
.Comment.Delete
'Adicionar novo
.AddComment
'Estado do comentário
.Comment.Visible = False
'Inserir texto
.Comment.Text Text:=sTexto
End With
Obrigado desde já!!!!
Postado : 28/08/2014 6:42 am