Problema com macro Colar Especial
Enviado: Qua Ago 03, 2022 8:53 am
Bom dia pessoal.
Preciso de ajuda com a macro abaixo.
Quando vou colar os dados de um planilha do excel com a macro ela dá um erro e preciso selecionar e copiar novamente os dados e colar com o botão da macro. Aí ela funciona na segunda vez.
Como se resolve este problema?
Grato
Silvio Felinto
P.S. - Não consigo anexar a pasta do Excel com o exemplo do problema. Está dando o seguinte erro:
Preciso de ajuda com a macro abaixo.
Quando vou colar os dados de um planilha do excel com a macro ela dá um erro e preciso selecionar e copiar novamente os dados e colar com o botão da macro. Aí ela funciona na segunda vez.
Como se resolve este problema?
Grato
Silvio Felinto
Código: Selecionar todos
Sub Colar_Dados_Especial_123()
'
Dim convenio As Range
Dim msgResposta As VbMsgBoxResult
Set convenio = Range("E4")
' COLOARESPECIAL123 Macro
Application.ScreenUpdating = False
On Error GoTo TE
ActiveSheet.Unprotect "123"
If Range("E4").Value = "" Then
MsgBox "QUAL O Nº DO PEDIDO?"
Exit Sub
End If
msgResposta = MsgBox("**************** CUIDADO! ****************" & Chr(13) & Chr(13) & "Tem certeza que os dados são deste PEDIDO nº " & PEDIDO & "?", vbYesNo)
If msgResposta = vbYes Then
If Range("D11").Value = "" Then
Range("D1").End(xlDown).Offset(2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D11").Select
Application.CutCopyMode = False
'Variável para a linha de inicio da execução
lin = 11
'Fazer até que a coluna 4 esteja vazia
Do Until Cells(lin, 4) = ""
'Preencher a coluna 3 com o número do CV...
Cells(lin, 3).Value = Range("E4").Value
lin = lin + 1
Loop
Range("D11").Select
ActiveCell.Offset(0, 12).End(xlDown).Offset(1, 0).Select
ElseIf Range("D11").Value <> "" Then
Range("D11").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D11").Select
Application.CutCopyMode = False
'Variável para a linha de inicio da execução
lin = 11
'Fazer até que a coluna 4 esteja vazia
Do Until Cells(lin, 4) = ""
'Preencher a coluna 3 com o número do CV...
Cells(lin, 3).Value = Range("E4").Value
lin = lin + 1
Loop
Range("C11").ClearContents
Range("D11").Select
ActiveCell.Offset(0, 12).End(xlDown).Offset(1, 0).Select
End If
Else
End If
ActiveSheet.Protect "123"
Exit Sub
TE: 'Tratamento de Erros
MsgBox "O Seguinte erro ocorreu: " & Err.Description & Chr(13) & "Copie e cole novamente até encontramos uma solução."
Application.ScreenUpdating = True
End Sub- Tela de erro no fórum.PNG (39.28 KiB) Exibido 857 vezes