Notifications
Clear all

COPIAR DADOS DE UMA PLANILHA PARA OUTRA COM CRITERIOS

2 Posts
2 Usuários
0 Reactions
1,187 Visualizações
(@caiocito)
Posts: 37
Eminent Member
Topic starter
 

Olá pessoal boa tarde!

Estou aqui pensando em uma maneira de resolver o meu problema porém esbarrei em alguns obstáculos e acredito que o pessoal ai mais entendido de vba vai poder me ajudar.

Vou tentar explicar meu problema. Tenho duas planilhas: A planilha TESTE e a IMPORTACAO_CARGA_TESTE.

Eu recebo os dados na planilha TESTE e desejo transformar esses dados na planilha IMPORTACAO_CARGA_TESTE, exatamente da maneira como eles estão lá. Pois essa segunda planilha será utilizada para fazer a importacao para um programa q lê o arquivo somente se estiver naquele formato.

Bom. Para isso tenho q respeitar a seguintes regras:
- Na planilha TESTE temos a coluna "ID" e essa coluna deve ser copiada para a coluna que tem escrito "Cód. Causa", conforme planilha em anexo;
- Na planilha TESTE temos a coluna "Contrato" e essa coluna deve ser copiada para a coluna que tem escrito "Cód. Ref. Causa", conforme planilha em anexo;
- Para as outras colunas devo seguir a mesma lógica, porém quando tenho dados diferentes para o mesmo contrato por exemplo, preciso repetir todos os dados e acrescentar o dado novo em outra coluna, por exemplo, se eu tiver 3 colunas de telefone, preciso ter na planilha IMPORTACAO_CARGA_TESTE, 3 linhas com as informações do contrato e o numero do telefone. Desta forma o programa conseguirá ler e importar todos os telefones de forma automatica.

Gostaria de um codigo dinamico onde o mesmo pudesse acrecentar mais colunas e poder desmembra-las automaticamente. Nao sei se consegui explicar o problema. Aguardo retorno obrigado.

 
Postado : 27/09/2017 2:28 pm
(@osvaldomp)
Posts: 857
Prominent Member
 

Considerei que ambos os arquivos (que você trata por planilha) estarão abertos ao rodar o código.
Experimente:

Sub ReplicaDados()
 Dim wsO As Worksheet, wsD As Worksheet, k As Long, LR As Long, LC As Long, m As Long
  Set wsO = Workbooks("TESTE-3").Sheets("delayed-receivables-2017-09-19")
  Set wsD = Workbooks("IMPORTACAO_CARGA_TESTE").Sheets("DADOS")
  If wsD.[A5] <> "" Then wsD.Range("A5:D" & wsD.Cells(Rows.Count, 1).End(3).Row) = ""
  LR = wsO.Cells(Rows.Count, 1).End(3).Row
   For k = 2 To LR
    With wsO
     LC = .Cells(k, Columns.Count).End(1).Column
      For m = 9 To LC
       If .Cells(k, m) <> "" Then
        wsD.Cells(Rows.Count, 1).End(3)(2).Resize(, 2).Value = .Cells(k, 1).Resize(, 2).Value
        wsD.Cells(Rows.Count, 3).End(3)(2) = .Cells(k, 8)
        wsD.Cells(Rows.Count, 4).End(3)(2) = .Cells(k, m)
       End If
      Next m
    End With
   Next k
End Sub

Osvaldo

 
Postado : 27/09/2017 3:37 pm