Este fórum está sendo desativado

[Foccomkt]

ola Pessoal alguem pode me ajudar a criar uma macro que faça o seguinte :

pegue os itens abaixo

"CICLONE DISTRIBUIDORA
Pet Shop

R Taveira Júnior, 426 - s-2
Nonoai - Porto Alegre, RS Como Chegar
ver telefone
(51) 3266-17aa"

e os deixe assim :
Empresa Endereço Bairro Cidade
STILO ANIMAL Av Protásio Alves, 1706 Rio Branco Porto Alegre

tenho uma listagem de mais de 14 mil Pet e preciso colocar assim, tentei fazer a macro mas ela nao deu certo, podem me ajudar?

Desde ja agradeço

[Parkeless]

Bom dia!

Você consegue postar uma planilha com os dados brutos, com uns dois ou três exemplos de como está a princípio e como você quer deixar?

[Foccomkt]

Empresa Endereço Bairro Cidade
PET SHOP PROBEM R Florianópolis, 4671 - s-01 Mathias Velho Canoas

FINO FARO PET SHOP
Pet Shop

Av Açucena, 1605
Estância Velha - Canoas, RS Como Chegar
ver telefone
(51) 3468-10aa
ANIMANOS PET SHOP
Pet Shop

R Boa Saúde, 65
Rio Branco - Canoas, RS Como Chegar
ver telefone
(51) 3059-25aa
PET SHOP MAIA FILHO
Pet Shop


Entendeu?

[Parkeless]

Não está claro se os dados a princípio estão em colunas diferentes ou em uma apenas, e também se o resultado que você quer após a formatação deve estar em uma coluna ou distribuído em várias... além disso as seguintes linhas:

FINO FARO PET SHOP
Pet Shop

...estão perdidas ali no meio; teria mais dados em cima?

Ou você anexa a planilha, ou especifica os detalhes do que você quer, caso contrário, não tem como te ajudar...

[Foccomkt]

Veja o anexo por favor

[Parkeless]

Bom dia!

Tenta isso:

Código: Selecionar todos

Sub Parkeless()
Dim linha As Long

Dim texto
Application.ScreenUpdating = False
'Determinar cabeçalhos
Range("C1") = "Empresa": Range("D1") = "Endereço": Range("E1") = "Bairro": Range("F1") = "Cidade"

For linha = 1 To Range("A1000000").End(xlUp).Row
    If Cells(linha, 1) = "ver telefone" Then
        'Bairro
        texto = Split(Cells(linha - 1, 1), "-"): Range("E1000000").End(xlUp).Offset(1, 0) = Trim(texto(0))
        'Cidade
        texto = Split(texto(1), ","): Range("F1000000").End(xlUp).Offset(1, 0) = Trim(texto(0))
        'Endereço
        Range("D1000000").End(xlUp).Offset(1, 0) = Trim(Cells(linha - 2, 1))
        'Empresa
        Range("C1000000").End(xlUp).Offset(1, 0) = Trim(Cells(linha - 5, 1))
        
    End If
    

Next linha
Application.ScreenUpdating = True
End Sub

Considerando que os dados vão seguir sempre o padrão do anexo informado, e os dados brutos estarão na coluna A.

Anexo exemplo de aplicação.