Notifications
Clear all

COPIAR DADOS COM CRITERIO

4 Posts
2 Usuários
0 Reactions
1,246 Visualizações
(@divinors)
Posts: 23
Eminent Member
Topic starter
 

Olá amigos

Solicito ajuda em uma macro onde:

1 - Vou ler vários códigos na plan1 (i, 4) e copiar os demais dados colunas 1, 2 e 3 e para (os determinados códigos da coluna 4) ele vai atribuir ST01 na coluna 04 da PLAN2. Conforme código abaixo.

2 - Só consegui copiar a primeira linha e sem conversão para ST01 na plan2.

Sub Copia()
Dim ST01 As String
ST01 = Plan1.Range("J1").Value

Plan2.Activate  'Ativando a planilha 2 que vai receber os dados
Plan2.Range("A2:D50000").ClearContents 'Limpando o conteudo da planilha 2

ultimaLinha = Plan1.Cells(Rows.Count, "a").End(xlUp).Row  'Fazendo a leitura de todas as linhas da planilha 1
lin = 2

For i = 2 To ultimaLinha
   If Plan1.Cells(i, 1) <> "" And Plan1.Cells(i, 4) = ST01 Then
   
       Plan2.Cells(lin, 1) = Plan1.Cells(i, 1)   'Planilha 2 recebe os dados da Planilha 1
       Plan2.Cells(lin, 2) = Plan1.Cells(i, 2)   'Planilha 2 recebe os dados da Planilha 1
       Plan2.Cells(lin, 3) = Plan1.Cells(i, 3)   'Planilha 2 recebe os dados da Planilha 1
       Plan2.Cells(lin, 4) = Plan1.Cells(i, 4)   'Planilha 2 recebe os dados da Planilha 1
       
              
       lin = lin + 1
    End If
Next

End Sub

Desde já agradeço antecipadamente a ajuda.
Divino Rodrigues.

 
Postado : 05/07/2017 5:52 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

DIVINORS,

Bom dia!

Não vi nenhum erro no seu código. Ele está copiando corretamente conforme você determinou no código! Ou seja: a primeira linha do seu código é esta:

ST01 = Plan1.Range("J1").Value

Você está atribuindo a variável ST01 o valor que está contido em J1.

Dentro do laço, você pede para que seja verificado se o valor contido na coluna D é igual ao contido na variável ST01

   If Plan1.Cells(i, 1) <> "" And Plan1.Cells(i, 4) = ST01 Then

Na sua planilha, a única linha que é igual a J1 (valor que foi gravado em ST01 na primeira linha do seu código) é a linha 2. Portanto, o código está copiando corretamente somente essa linha.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 05/07/2017 6:33 am
(@divinors)
Posts: 23
Eminent Member
Topic starter
 

Obrigado pela atenção. Essa planilha é um teste.
1- Na verdade ela vai ter centena de linhas (dados) onde a macro encontrar o conjunto dos dez códigos descritos (determinados),
2- A macro deverá copiar como sendo ST01 para a coluna "D" da plan2.
3- Ou seja a macro lê determinados códigos na plan1 e copia como ST01 na plan2. Só consegui copiar uma linha.

 
Postado : 05/07/2017 6:43 am
(@divinors)
Posts: 23
Eminent Member
Topic starter
 

DIVINORS,

Bom dia!

Não vi nenhum erro no seu código. Ele está copiando corretamente conforme você determinou no código! Ou seja: a primeira linha do seu código é esta:

ST01 = Plan1.Range("J1").Value

Você está atribuindo a variável ST01 o valor que está contido em J1.

Dentro do laço, você pede para que seja verificado se o valor contido na coluna D é igual ao contido na variável ST01

   If Plan1.Cells(i, 1) <> "" And Plan1.Cells(i, 4) = ST01 Then

Na sua planilha, a única linha que é igual a J1 (valor que foi gravado em ST01 na primeira linha do seu código) é a linha 2. Portanto, o código está copiando corretamente somente essa linha.

Obrigado pela atenção. Essa planilha é um teste.
1- Na verdade ela vai ter centena de linhas (dados) onde a macro encontrar o conjunto dos dez códigos descritos (determinados),
2- A macro deverá copiar como sendo ST01 para a coluna "D" da plan2.
3- Ou seja a macro lê determinados códigos na plan1 e copia como ST01 na plan2. Só consegui copiar uma linha.
4-Eu gostaria de determinar que para os 10 codigos encontrados a macro levaria para a plan2 apenas ST01.
DIVINORS
Membro
Membro

Mensagens: 18
Registrado em: Ter Dez 20, 2016 11:57 pm
Agradeceu : 10 vezes
Foi agradecido: 1 time

 
Postado : 05/07/2017 7:18 am