Notifications
Clear all

Copy e pastespecial

8 Posts
5 Usuários
0 Reactions
3,476 Visualizações
(@zepax)
Posts: 0
New Member
Topic starter
 

Boa Tarde.

Eu estava montando uma planilha para o meu pai controlar alguns cheques, como ele não e muito bom com planilhas, ele estava deletando dados do banco de dados, então resolvi criar uma macro para evitar isso.

a macro consiste e pegar as informações cadastradas de uma aba e colar na outra (q ambas estão protegidas por senha) na primeira linha vazia e assim saiu isso.

Private Sub CommandButton1_Click()
Sheets("LANÇAMENTO").Select
ActiveSheet.Unprotect "0000"
ActiveSheet.Range("B4:S4").Select
Selection.Copy
Sheets("CHEQUES").Select
ActiveSheet.Unprotect "0000"
ActiveSheet.Range("E7").Select
ActiveSheet.Range("E10485").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("E7").Select
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="0000"
Sheets("LANÇAMENTO").Select
ActiveSheet.Range("U4:AL4").Select
Selection.Copy
Range("B4").Select
ActiveSheet.Paste
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, Password:="0000"
MsgBox "Cheque Lançado"
End Sub

Quando eu clico no botão a primeira vez, a macro roda inteira, na segunda vez surgem erros, as vezes ( Erro em tempo de execução '1004' Erro de definição de aplicativo ou de definição de objeto) ou ( Erro em tempo de execução '1004' O método pastespecial da classe range falhou)e o depurador mostra em amarelo a sequencia

Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, _
Transpose:=False

Se eu ignorar o erro e apertar a terceira vez o botão ele funciona de novo, e na quarta da erro de novo, e assim vai.

desde já agradeço a ajuda.

 
Postado : 15/10/2015 3:06 pm
(@mprudencio)
Posts: 0
New Member
 

Tenta adequar essa

..................................................

Sub Baixa()

Application.ScreenUpdating = False

Sheets("Lançamentos").Select

Range("H7").Select

Do While ActiveCell <> ""

If ActiveCell.Value = "PAGO" Then

Intersect(Selection.EntireRow, _
Range("A:G")).Select
Selection.Copy

Sheets("Pagos").Select

Range("A1048576").End(xlUp).Select
ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Selection.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Range("A2").Select

Sheets("Lançamentos").Select

ActiveCell.EntireRow.Delete

ActiveCell.Offset(0, 7).Select

Else

ActiveCell.Offset(1, 0).Select

End If

Loop

Range("A7").Select

ActiveWorkbook.RefreshAll

MsgBox "Dados Atualizados Com Sucesso", vbOKOnly, "Atualizando Dados..."

Application.ScreenUpdating = True

ActiveWorkbook.Save

End Sub

 
Postado : 15/10/2015 3:17 pm
(@zepax)
Posts: 0
New Member
Topic starter
 

Cara, obrigado pela tentativa....eu ACHO q eu tentei de tudo... mas ta complicado

Fiz um negocio mto complexo (pra mim) vou tentar da uma simplificada...

 
Postado : 04/11/2015 12:14 pm
(@edivan)
Posts: 0
New Member
 

Tenta isso: é claro que a parte onde você tem os códigos que retiram a senha da planilha eu nao fiz, só fiz mesmo o código que pega os dados da planilha "LANÇAMENTOS" e joga para a próxima linha vazia da planilha "CHEQUES" teste aí....

Private Sub CommandButton1_Click()

Dim lin As Integer
lin = 7

Do Until Sheets("cheques").Cells(lin, 5) = ""
lin = lin + 1
Loop

Sheets("CHEQUES").Cells(lin, 5) = Sheets("LANÇAMENTO").Cells(4, 2)
Sheets("CHEQUES").Cells(lin, 6) = Sheets("LANÇAMENTO").Cells(4, 3)
Sheets("CHEQUES").Cells(lin, 7) = Sheets("LANÇAMENTO").Cells(4, 4)
Sheets("CHEQUES").Cells(lin, 8) = Sheets("LANÇAMENTO").Cells(4, 5)
Sheets("CHEQUES").Cells(lin, 9) = Sheets("LANÇAMENTO").Cells(4, 6)
Sheets("CHEQUES").Cells(lin, 10) = Sheets("LANÇAMENTO").Cells(4, 7)
Sheets("CHEQUES").Cells(lin, 11) = Sheets("LANÇAMENTO").Cells(4, 8)
Sheets("CHEQUES").Cells(lin, 12) = Sheets("LANÇAMENTO").Cells(4, 9)
Sheets("CHEQUES").Cells(lin, 13) = Sheets("LANÇAMENTO").Cells(4, 10)
Sheets("CHEQUES").Cells(lin, 14) = Sheets("LANÇAMENTO").Cells(4, 11)
Sheets("CHEQUES").Cells(lin, 15) = Sheets("LANÇAMENTO").Cells(4, 12)
Sheets("CHEQUES").Cells(lin, 16) = Sheets("LANÇAMENTO").Cells(4, 13)
Sheets("CHEQUES").Cells(lin, 17) = Sheets("LANÇAMENTO").Cells(4, 14)
Sheets("CHEQUES").Cells(lin, 18) = Sheets("LANÇAMENTO").Cells(4, 15)
Sheets("CHEQUES").Cells(lin, 19) = Sheets("LANÇAMENTO").Cells(4, 16)
Sheets("CHEQUES").Cells(lin, 20) = Sheets("LANÇAMENTO").Cells(4, 17)
Sheets("CHEQUES").Cells(lin, 21) = Sheets("LANÇAMENTO").Cells(4, 18)
Sheets("CHEQUES").Cells(lin, 22) = Sheets("LANÇAMENTO").Cells(4, 19)

MsgBox "Cheque Lançado"

End Sub

 
Postado : 04/11/2015 1:03 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Poste seu arquivo modelo!!

Att

 
Postado : 04/11/2015 1:47 pm
(@zepax)
Posts: 0
New Member
Topic starter
 

Segue anexo a planilha.

Obrigado

 
Postado : 12/11/2015 2:22 pm
(@mprudencio)
Posts: 0
New Member
 

Ve se isso ajuda

Troque isso

Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, _
Transpose:=False

Por isso

Selection.PasteSpecial Paste:=xlPasteAll

Veja a planilha em anexo

 
Postado : 12/11/2015 3:56 pm
 AJRL
(@ajrl)
Posts: 0
New Member
 

Boa noite.

O único erro que vi no seu código é: Paste:=xlValues (está faltando "Paste")
O correto seria...
Selection.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Tente mudar o código na sua planilha... Espero que rode!

 
Postado : 12/11/2015 3:59 pm