Vba excel

Douglas Martins Mendes Bra · 8 de setembro de 2016

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

DJunqueira · 8 de setembro de 2016

Nem toda solução passa por macro, se você anexar sua planilha outras alternativas mais simples poderão ser apresentadas.

Douglas Martins Mendes Bra · 9 de setembro de 2016

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.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

Douglas Martins Mendes Bra · 9 de setembro de 2016

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

DJunqueira · 9 de setembro de 2016

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