Ir ao conteúdo
  • Cadastre-se

Recommended Posts

Boa tarde, galera.

 

Estou com um pequeno problema com vba, sou iniciante e quero fazer um código que faça o seguinte, tenho uma planilha que na primeira linha fala qual é o grupo de uma determinada empresa, em baixo as empresas desse grupo.E assim por diante, sendo que tem uma linha em branco depois do final de cada grupo, gostaria de juntar todas as empresas com o grupo na frente delas em outra planilha. Fiz um pedaço do codigo, mas não está funcionando, se puderem ajudar fico grato . :)

Sub teste()

For i = 4 To 2308
    
    Sheets("Por grupo").Activate
    Cells(i, 1).Select
    d = 1

    While d <> ""

        If ActiveCell.Value <> " " Then
            e = ActiveCell.Offset(0, 1)
            ActiveCell.Cells(i, 1).Offset(1, 0).Select
        Else
            d = ActiveCell.Cells(i, 1).Offset(-2, 0).Value
            Sheets("Grupos Fornecedores").Activate
            ActiveCell.Cells(i, 1).Value = d
            ActiveCell.Cells(i, 1).Offset(0, 1).Value = e
            Range("e1").Value = "oi"
            d = ""
        End If
             
    Wend

Next i

End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

CNPJ                                       ANO: 2016

                                                  NOME

  

5200002                          SERV MEDICOS GRUPOS MEDICOS - PF (CUSTO)

00.007.437/0337-55          CRISTIANE CHAVES DE SOUZA PESSANHA

  

  

5200003                            SERVICOS MEDICOS(PJ) - REDE PROPRIA

00.099.654/0001-14          DAPMED SERVICOS MEDICOS SC LTDA

00.099.654/0001-14          DAPMED SERVICOS MEDICOS SC LTDA

00.099.654/0001-14          DAPMED SERVICOS MEDICOS SC LTDA

00.123.294/0001-49          CENTRO INTEGRADO DE UROLOGIA DO RIO DE J

01.026.869/0001-78          NEUROPEDIATRAS ASSOCIADOS LTDA EPP

 

O formato é mais ou menos esse, mas tem umas duas mil linhas, esse primeiro numero é o grupo das empresas abaixo, gostaria que fosse copiado o nome da empresa e ao lado o grupo de pagamento

adicionado 55 minutos depois

Aqui a planilha, gostaria que ficasse assim.

Novo(a) Planilha do Microsoft Excel (2).xlsx

Compartilhar este post


Link para o post
Compartilhar em outros sites
Sub teste()

Cells(4, 1).Select

 For i = 1 To 3000
    Sheets("Por grupo").Activate
    If ActiveCell.Value <> "" Then
       ActiveCell.Offset(-1, 0).Select
       
    Else
       g = ActiveCell.Offset(1, 0).Value
       ActiveCell.Offset(2, 0).Select
        While ActiveCell.Value <> ""
            d = ActiveCell.Offset(0, 1).Value
            Sheets("Grupos Fornecedores").Activate
            Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
            ActiveCell.Value = g
            ActiveCell.Offset(0, 1).Value = d
            Sheets("Por grupo").Activate
            ActiveCell.Offset(1, 0).Select
        Wend
        
        If ActiveCell.Value = "" Then
                    ActiveCell.Offset(2, 0).Select
                End If
        
    End If
    
Next i

End Sub

Acho que consegui, obrigado :)

Compartilhar este post


Link para o post
Compartilhar em outros sites

Dependendo da sua versão do Excel (2013 ou 2016) você poderia alcançar o mesmo resultado com Nova Consulta / Power Query, veja como na planilha anexada.

A vantagem desse método é q requer menor manutenção e é mais simples de se montar.

Controle convênios.xlsx

Editado por DJunqueira
  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×