Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
AJUDA PARA TRANSPOR...
 
Notifications
Clear all

AJUDA PARA TRANSPOR DADOS

 
2024 - VBA & Macros
Post Recente por FragosoJP 6 anos atrás
3 Posts
2 Usuários
0 Reactions
1,055 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
 FragosoJP
(@fragosojp)
Posts: 101
Estimable Member
Topic starter
 

Muitoooo

obrigado klarc28

funcionou perfeitamente.

 
Postado : 27/03/2018 10:15 am
Forum Jump:
  Tópico Anterior
Próximo Tópico