AJUDA PARA TRANSPOR DADOS

2024 - VBA & Macros

Post Recente por FragosoJP 7 anos atrás

3 Posts

2 Usuários

0 Reactions

1,057 Visualizações

RSS

FragosoJP

(@fragosojp)

Posts: 101

Estimable Member

Topic starter

Bom dia Galera

preciso de uma ajuda

tenho uma planilha aonde eu preciso transpor os dados da seguinte forma:

Na aba "Dados" tenho as informações em linhas da seguinte forma, na coluna "A até K" tenho as informações cadastrais,e na coluna "L até CI" tenho os períodos (Ex: Ago/11 até Dez/17)

Obs: abaixo de cada período tem a informação de "Falta"
EX:
nº Empresa Cadastro Nome Situação Função Admissão Posto Cidade Responsável Observações ago/11 set/11 out/11 nov/11 dez/11
175 X 1234 JOAO Trabalhando AUX. ADM 04/02/2016 AAAAAAAAA BBBBB JOAO P Trabalhando Falta Falta Falta

gostaria de transpor apenas aonde a informação consta a informação "falta" para puxar o período, conforme exemplo abaixo.

Cadastro Nome Função POSTO RESPONSAVEL DATA
1234 JOAO AUX. ADM AAAAAAAAA JOAO P ago/11
1234 JOAO AUX. ADM AAAAAAAAA JOAO P set/11
1234 JOAO AUX. ADM AAAAAAAAA JOAO P out/11

tentei fazer uma macro mas sem Sucesso.

Postado : 27/03/2018 7:39 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Neste fórum, não se deve usar a palavra "ajuda" no título do tópico.

Option Explicit

Sub teste()
    Dim lin As Long
   
    With Sheets("DADOS")
        Dim LINHA As Long
        LINHA = 2
        
        While .Range("A" & LINHA).Value <> ""
            
            
            
            LINHA = LINHA + 1
        Wend
        
    End With
    
    For lin = 2 To LINHA - 1
        With Sheets("TRANSPOR")
            Dim LINHA2 As Long
            LINHA2 = 2
            
            While .Range("A" & LINHA2).Value <> ""
                
                
                LINHA2 = LINHA2 + 1
            Wend
            
            Dim COLUNA As Long
            For COLUNA = 12 To 100
                If Sheets("DADOS").Cells(lin, COLUNA).Value = "FALTA" Then
                    .Range("A" & LINHA2).Value = Sheets("DADOS").Range("C" & lin).Value
                    .Range("B" & LINHA2).Value = Sheets("DADOS").Range("D" & lin).Value
                    .Range("C" & LINHA2).Value = Sheets("DADOS").Range("F" & lin).Value
                    .Range("D" & LINHA2).Value = Sheets("DADOS").Range("H" & lin).Value
                    .Range("E" & LINHA2).Value = Sheets("DADOS").Range("J" & lin).Value
                    
                    .Range("F" & LINHA2).Value = Sheets("DADOS").Cells(1, COLUNA).Value
                    LINHA2 = LINHA2 + 1
                End If
               Next COLUNA
            
        End With
    Next lin
    
    
End Sub

Postado : 27/03/2018 7:57 am