Copiar dados alinhando

2024 - VBA & Macros

Post Recente por FragosoJP 7 anos atrás

3 Posts

2 Usuários

0 Reactions

1,034 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