Notifications

Clear all

COPIAR E COLAR COM CONDICOES

2024 - VBA & Macros

Post Recente por ooigor 9 anos atrás

4 Posts

2 Usuários

0 Reactions

962 Visualizações

RSS

ooigor

(@ooigor)

Posts: 22

Eminent Member

Topic starter

O que quero é o seguinte:

Se a coluna E1 for igual a 01, copiar os valores da coluna A1,B1,C1, e colar na Plan2 na proxima linha vazia
Se a coluna E2 for igual a 01, copiar os valores da coluna A2,B2,C2 e e colar na Plan2 na proxima linha vazia. E assim em diante..

É possível criar uma rotina assim?

Postado : 02/10/2015 6:07 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Sempre que tiver 01 na coluna E vai copiar de A ate C da linha correspondente e colar em outra plan, se é isso sim é possivel.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 02/10/2015 7:16 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Tente assim

Cole isso em um modulo

Sub COPIA()

Dim W1, W2 As Worksheet
Dim BUS As String

Set W1 = Sheets("Plan1")
Set W2 = Sheets("Plan2")

W1.Select
W1.Range("E2").Select
BUS = 1

Do While ActiveCell <> ""

If ActiveCell = BUS Then

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

W2.Select

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

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

Range("A2").Select

W1.Select

ActiveCell.Offset(1, 4).Select

Else

ActiveCell.Offset(1, 0).Select

End If

Loop

Range("A2").Select

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

Application.ScreenUpdating = True

ActiveWorkbook.Save

End Sub