TRANSPOR COLUNAS EM LINHAS

[luiza lopes]

Olá,

Eu uso essa macro para transpor linhas em colunas, mas vejo que com a adição de mais linhas ela fica cada vez mais lenta. Alguém teria uma solução para isso? De modo que a macro pegasse somente as informações das linhas mais atuais? 

<> 

Sub TransporDados1()
    
    'Declarações

    Dim Arr() As Variant
    Dim LastRow As Variant, j As Long, linha As Long, coluna As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Application.ScreenUpdating = False
    
    'Declara a planilha com os dados
    Set ws1 = ThisWorkbook.Sheets("BD")
    Set ws2 = ThisWorkbook.Sheets("Análise de Dados")
    'Em ws1:
    With ws1
        'ÚltimaLinha
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'Array
        Arr() = .Range("B2:B" & LastRow).Value2
              
        linha = 2
        coluna = 1
        
        'Loop em cada elemento da Array
        For j = LBound(Arr) To UBound(Arr)
           ws2.Cells(linha, coluna) = Arr(j, 1)
           coluna = coluna + 1
           
           'Quando preencher 9 células, passa para próxima linha e zera contador de coluna
           If coluna = 11 Then
            linha = linha + 1
            coluna = 1
           End If
        
        Next j
        
    End With
        Application.ScreenUpdating = True
    
    'Call timer2
End Sub

 

[Alyson Ronnan Martins]

Boa noite @luiza lopes.

Usa o comando no início do seu código:

Sub TransporDados1()
 
Application.ScreenUpdating = False

... 'Seu codigo


Application.ScreenUpdating = True

End Sub

 

Editado Março 16, 2020 por Alyson Ronnan Martins
Melhor o código

[luiza lopes]

Oii @Alyson Ronnan Martins tentei fazer isso mas aparentemente está demorando mais que antes, mais alguma sugestão? 🙂

 

[Alyson Ronnan Martins]

Sua planilha tem muitas formulas?

[luiza lopes]

sim, e outra coisa é que são varias linhas e por isso uso uma macro para transpor cada uma em uma coluna diferente.

Teria como um único código transpor todas de uma vez só? Essa tabela é só um representativo do que estou transportando. As colunas possuem parâmetros diferentes  

[Alyson Ronnan Martins]

Então tenta desativar o calculo da fórmula:

Sub Auto_Calcs_Example()
    Application.Calculation = xlManual
 
    'Do something
 
 
 
    Application.Calculation = xlAutomatic
End Sub

E no final coloca automático 

Editado Março 17, 2020 por Alyson Ronnan Martins
Erro de fórmula

[luiza lopes]

certo! e quanto a outra macro de repor todas as linhas nas colunas em uma só, alguma ideia de como posso fazer isso?

 

[Alyson Ronnan Martins]

Deu certo essa?

Não estou lembrando da outra.

Editado Março 17, 2020 por Alyson Ronnan Martins
Erro de digitação

[luiza lopes]

Vou testar ainda! É que eu tinha outra dúvida também, de como juntar as três macros que eu uso para transpor dados em uma. Você acha que teria como?

A tabela que eu uso é essa aqui:

e cada coluna em branco eu uso uma macro para transpor cada linha individual em uma coluna. O código é o mesmo que enviei 

 

[luiza lopes]

@Alyson Ronnan Martins

[Alyson Ronnan Martins]

Opa.

Teria como me enviar a planilha?

 

[luiza lopes]

Não consigo enviar a planilha por aqui. Estou enviando como eu gostaria que ficasse. A primeira figura estaria em uma aba denominada "BD" e a Segunda em outra aba com nome " Análise de Dados".

 

 

@Alyson Ronnan Martins por favor me avise caso precise de mais alguma informação

 

[Alyson Ronnan Martins]

Vou agora tentar fazer um código para a mesma ideias em abas diferêntes

 

[luiza lopes]

Certo, muito obrigada!

 

[Alyson Ronnan Martins]

Eu fiz uma planilha com a mesma ideia que você mandou na foto.

Foi acrescentando na linha 1 a planilha destino para estar "pre-definido" o destino para onde vai levar as informações

https://drive.google.com/open?id=1GUm6juULIhsBcn0loHM7ABsaAq9lzD-P

Sub cmdTranporValores()
'Criar variaveis
Dim Tabela As String 'Noma da tabla que vai ser levadas as informações
Dim nTabelas As Long 'Quantidade de tabela para transpor
Dim uLinha As Long 'Última linha
Dim uColuna As Long 'Última coluna
Dim y As Long 'Valor para coluna

'Identificar
uColuna = Sheets("Dados").Cells(1, Columns.Count).End(xlToLeft).Column
nTabelas = uColuna / 2
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Loop para passsar de colunas
For y = 1 To uColuna Step 2

    Tabela = Sheets("Dados").Cells(1, y + 1).Value
    uLinha = Sheets("Dados").Cells(Rows.Count, y).End(xlUp).Row
    
    Sheets("Dados").Select
    Sheets("Dados").Range(Cells(2, y), Cells(uLinha, y + 1)).Select
    Selection.Copy
    Sheets(Tabela).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Dados").Select
Next y

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic

End Sub

 

[luiza lopes]

Oii, então o código criado  ficou mtu bom! Atende quase tudo o que eu preciso. Vou tentar te explicar melhor o que acontece com a tabela usando valores diferentes. Vou mandar os prints aqui. As duas figuras são em abas diferentes. Antes eu usei "Nome do Produto" como exemplo, agora acho que com esse exemplo ficou  mais claro. Obrigada desde jaaa

Oii, então o código criado  ficou mtu bom! Atende quase tudo o que eu preciso. Vou tentar te explicar melhor o que acontece com a tabela usando valores diferentes. Vou mandar os prints aqui. As duas figuras são em abas diferentes. Antes eu usei "Nome do Produto" como exemplo, agora acho que com esse exemplo ficou  mais claro. Obrigada desde jaaa. Creio que só falte adicionar um loop das informações e colocar todas na mesma aba.

[Alyson Ronnan Martins]

Mais todos os valores estão sendo jogados dentro de uma tabela?

[luiza lopes]

Os valores que nunca mudam são os da coluna 1, 3 e 5. A tabela original seria essa e funcionaria de modo que cada vez uma pessoa diferente iria preencher os dados com valores diferentes. E agora eu preciso transpor esses dados para colunas diferentes porem na mesma aba. 

Me avise se ainda não ficou claro a ideia, por favor! Você está me ajudando mtu

 

[Alyson Ronnan Martins]

Mais ele passam de de 7 em 7 linhas para uma linha nova na próxima linha?

[luiza lopes]

Sim, serão 7 informações preenchidas. Mas só as informações da 2,4 e 6 colunas que devem ser transpostas na outra aba. Como se fosse assim:

Essa foto é da aba com as informações transpostas já

[Alyson Ronnan Martins]

Então vou precisa pular de 7 em 7 linha para linha nova de transpor. Já te mando um exemplo para testar.

[luiza lopes]

Exatamente isso! O problema é que as colunas que preciso as informações são mescladas. Tipo preciso só das informações das linhas 2, 4 e 6 e essas informações fariam de 7 em 7 linhas. 

[Alyson Ronnan Martins]

Não vi colunas mescladas tem alguam exemplo disso?

 

[luiza lopes]

Claro! vou te mandar a tabela sem preencher que fica mais claro:

Essa é a tabela, o esquema é cada pessoa vai preencher ela de modo diferente e preciso transpor essas informações para outra aba. As informações que quero transpor são aquelas que as pessoas vão preencher ( espaço em branco).

Veja se ficou mais claro agora!

E as informações tem que ficar assim na outra aba @Alyson Ronnan Martins

Editado Março 20, 2020 por luiza lopes

[Alyson Ronnan Martins]

Eu fiz um tabela fictíca com valores mais ou menos que ficaram na foto.

Sub cmdImportarTexto()
Dim uLinha As Long 'Última linha

Dim lLista As Long 'Linha nova na tabela Lista
Dim cLista As Long 'Coluna nova na tabela lista
Dim yLista As Long 'Coluna pesquinsando a lista

Dim g As Long 'Grupo do produto
Dim x As Long 'Linha
Dim y As Long 'Coluna

Dim txtCampo
Dim txtValor

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

uLinha = Sheets("Dados").Cells(Rows.Count, "A").End(xlUp).Row

'Loop pulando de 7 em 7 linha começando na linha 1 até a ultima linha
For g = 1 To uLinha Step 7

    'Ultima linha da lista
    lLista = Sheets("Lista").Cells(Rows.Count, "A").End(xlUp).Row + 1

    'Loop pulando de 2 em 2 começando na coluna 2 até 6
    For y = 2 To 6 Step 2
        'Loop para passar pelas linhas
        For x = g To g + 6 Step 1
            txtCampo = Sheets("Dados").Cells(x, y - 1).Value
            txtValor = Sheets("Dados").Cells(x, y).Value
            
            'Procurar a coluna para colocar o valor
            For yLista = 1 To 21 Step 1
                If Sheets("Lista").Cells(1, yLista).Value = txtCampo Then
                    cLista = yLista
                    yLista = 22 'Parar o for
                    
                End If
            Next yLista
            
            'Cadastrar o valor na tabela nova
            Sheets("Lista").Cells(lLista, cLista).Value = txtValor
            
        Next
    Next y
Next g

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Link da planilha:

https://drive.google.com/open?id=1R3TqwBk4ylki9L1B0uhhi4cK3DsnTlbS

[luiza lopes]

Primeiro, muito obrigada pela ajuda @Alyson Ronnan Martins! Agora, tentei rodar no meu computador mudando apenas o nome das abas e aparece isso:

Nessa linha aqui, alguma ideia para resolver esse problema?