Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar dados alinha...
 
Notifications
Clear all

Copiar dados alinhando

 
2024 - VBA & Macros
Post Recente por FragosoJP 7 anos atrás
3 Posts
2 Usuários
0 Reactions
1,032 Visualizações
RSS
 FragosoJP
(@fragosojp)
Posts: 101
Estimable Member
Topic starter
 

Bom dia Pessoas

Preciso de uma ajuda tenho extrai um relatório do sistema aonde trabalho com mais de 8.000 linhas
porem os dados vem de forma desordenada acada 3 linha ele apresenta os dados de um cliente
tem como realinhar os dados de forma que a informação fique alinhada conforme abaixo:

EX: dados extraíndo do sistema
Posto 1112 POSTO 2 Cliente 1245 CONTRATO 2
Endereço RUA 2 101 Cep 86800236 CENTRO2 Fone 43-3423-0455
Cidade CURITIBA2 Rota Fisc.: 1

Ex: realinhando os dados
COD POSTO CIDADE END END Nº BAIRRO NOME CONTRATO
111 POSTO 1 CURITIBA1 RUA 1 100 CENTRO1 CONTRATO 1
112 POSTO 2 CURITIBA2 RUA 2 101 CENTRO2 CONTRATO 2
113 POSTO 3 CURITIBA3 RUA 3 102 CENTRO3 CONTRATO 3
114 POSTO 4 CURITIBA4 RUA 4 103 CENTRO4 CONTRATO 4

 
Postado : 18/12/2017 8:57 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Favor marcar como resolvido.

Option Explicit

Sub copiarDados()
    Dim I As Long
    Dim LINHA As Long
    
    For I = 1 To ThisWorkbook.Sheets("DADOS").UsedRange.Rows.Count Step 3
        LINHA = 2
        
        
        While ThisWorkbook.Sheets("REALINHAR DADOS").Range("A" & LINHA).Value <> ""
            
            LINHA = LINHA + 1
        Wend
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("A" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("B" & I).Value
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("B" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("C" & I).Value
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("C" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("B" & I + 2).Value
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("D" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("B" & I + 1).Value
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("E" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("C" & I + 1).Value
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("F" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("G" & I + 1).Value
        ThisWorkbook.Sheets("REALINHAR DADOS").Range("G" & LINHA).Value = ThisWorkbook.Sheets("DADOS").Range("F" & I).Value
    Next I
End Sub
 
Postado : 18/12/2017 9:33 am
 FragosoJP
(@fragosojp)
Posts: 101
Estimable Member
Topic starter
 

Boa tarde Klarc28
sim apenas copiar os dados para outra planilha de forma ordenada

Muito obrigado funcionou perfeitamente.

 
Postado : 18/12/2017 9:57 am
Forum Jump:
  Tópico Anterior
Próximo Tópico