Olá.

Veja se entendi corretamente o que você precisa.

Sub CadaClienteEmUmaLinha()
 Dim rg As Range, k As Long, v() As Variant, LR As Long
 Dim i As Long, j As Long, x As Long, m As Long, cc As Long
  LR = Cells(1, 1).End(4).Row
   For cc = 2 To LR
    x = Application.CountIf(Range("A2:A" & LR), Cells(cc, 1))
    Set rg = Range(Cells(cc, 1), Cells(cc + x - 1, 1)).Resize(, 7)
    v = rg.Value
     For i = LBound(v) To UBound(v)
      For j = LBound(v, 2) To UBound(v, 2)
       Cells(m + 21, k + 1) = v(i, j)
        k = k + 1
      Next j
     Next i
     cc = cc + x - 1
     m = m + 1: k = 0
   Next cc
End Sub

Olá Oslvado! NO arquivo que enviei como exemplo funcionou perfeitamente. VOu testar no meu arquivo de trabalho (17mil linhas) e ver como se comporta. De antemão deixo meu muito obrigado! Qualquer coisa eu retorno.

Valeu!

F.

Olá novamente!

Apliquei as linhas em VBA em um dos bancos e funcionou perfeitamente. Fui realizar a mesma operação em um outro banco e me deparei apenas com uma dificuldade para a qual solicito novamente ajuda. Neste segundo banco (exemplo em anexo) a única diferença para o anterior é que ao transferir o conteúdo de múltiplas linhas com um mesmo identificador não há a necessidade de copiar todas as colunas, simplificando o resultado.

No arquivo, em verde ou azul estão as informações que precisam aparecer uma única vez. Em vermelho os campos que precisam ser transferidos para a mesma linha a qual o código de identificação se refere (co_usuario_farmacia). Ao final, cada linha deve referir-se apenas a um usuário identificado por seu código (co_usuario_farmacia).

Neste arquivo estão apenas dois usuários (11 e 20), mas o banco completo totaliza 17mil usuários, devendo a "linearização" ser realizada em todos eles.

Mais uma vez agradeço o conhecimento e ajuda de vocês!

F.

Experimente o código abaixo no seu segundo arquivo.

O resultado será colocado a partir da quinta linha vazia abaixo da tabela existente.

Sub CadaUsuárioEmUmaLinha()
Dim rg As Range, k As Long, v() As Variant, LR As Long
Dim i As Long, j As Long, x As Long, m As Long, cc As Long
  LR = Cells(1, 1).End(4).Row
   For cc = 2 To LR
    Set rg = Cells(cc, 1).Resize(, 17)
    Cells(m + LR + 5, k + 1).Resize(, 17).Value = rg.Value
    x = Application.CountIf(Range("A2:A" & LR), Cells(cc, 1))
    Set rg = Cells(cc, 18).Resize(x, 5)
     v = rg.Value
     For i = LBound(v) To UBound(v)
      For j = LBound(v, 2) To UBound(v, 2)
       Cells(m + LR + 5, k + 18) = v(i, j)
        k = k + 1
      Next j
     Next i
     cc = cc + x - 1
     m = m + 1: k = 0
    Next cc
End Sub