none
VBA Excel - procurar por um critério e copiar 2 células correspondentes a esse critério (linha) RRS feed

  • Pergunta

  • Bom dia,

    Precisava de saber se é possível fazer uma macro para o seguinte:

    A tabela 1 está sheet1; a tabela 2está na sheet2 e a tabela 3 está na sheet3.

    O que precisava era de um código que procurasse a informação nas tabelas 1 e 2 colocasse na tabela 3 como exemplificado. 


    Desde já agradeço a Vossa ajuda.

    Tabela 1

    Source Destiny total
    A L -10
    A M -12
    A N -2
    B O -3
    C P -5
    D Q -4
    E R -1
    F S -1
    F T -2

    Tabela 2

    Destiny Source total
    A L 21
    B M 12
    C N 5
    D O 4
    E P 1
    F Q 3
    G R 3
    H S 3
    H T 3

    Tabela 3

    S & D                
    A L -10      M -12       N -2       L 21
    B O -3      M 12  
    C P -5      N 5  
    D Q -4      O 4  
    E R -1      P 1  
    F S -1      T -2       Q 3  
    G R 3  
    H S 3  
    I T 3  
    J  
    K                


    domingo, 3 de setembro de 2017 21:22

Respostas

  • Option Explicit
    
    Sub TESTE()
        Dim linha As Long
        Dim linha2 As Long
        Dim col As Long
        Dim linha3 As Long
        
        Sheets("sheet3").Cells.Clear
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
            If linha = 2 Then
                ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
            If linha = 2 Then
                
                If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                    
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                End If
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                'linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                Else
                    Dim LINHA4 As Long
                    Dim ACHOU As Boolean
                    ACHOU = False
                    LINHA4 = 2
                    
                    While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 4) <> ""
                        
                        If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                            ACHOU = True
                        End If
                        LINHA4 = LINHA4 + 1
                        
                    Wend
                    
                    If ACHOU = True Then
                        
                        linha3 = 2
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        col = 1
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            col = col + 1
                            
                        Wend
                        
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    Else
                        
                        linha3 = 2
                        Dim ACHADO As Boolean
                        ACHADO = False
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" And ACHADO = False
                            If ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                                ACHADO = True
                                col = 1
                                While ThisWorkbook.Sheets("sheet3").Cells(linha3, col) <> ""
                                    
                                    col = col + 1
                                    
                                Wend
                                
                                ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                                ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                            End If
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        If ACHADO = False Then
                            ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1)
                            ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                            ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                        End If
                    End If
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        ThisWorkbook.Sheets("sheet3").Columns("B:B").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D"
        ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum"
        
        linha = 2
        Dim soma As Integer
        
        
        While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
            
            If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, 4)) Then
                soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4)
            End If
            col = 6
            While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                
                If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then
                    
                    soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value
                End If
                
                col = col + 1
            Wend
            ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma
            linha = linha + 1
        Wend
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quinta-feira, 7 de setembro de 2017 02:47
    • Marcado como Resposta R principiante terça-feira, 12 de setembro de 2017 17:54
    quinta-feira, 7 de setembro de 2017 02:46

Todas as Respostas

  • Option Explicit
    
    Sub TESTE()
    Dim linha As Long
    Dim linha2 As Long
    Dim col As Long
    linha = 2
    Sheets("sheet3").Cells.Clear
    While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
    If linha = 2 Then
    ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
    ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
    
    Else
    linha2 = 2
    While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
    
    linha2 = linha2 + 1
    Wend
    linha2 = linha2 - 1
    If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
    
    col = 1
    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
    
    col = col + 1
    
    Wend
    
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
    End If
    
    
    End If
    linha = linha + 1
    
    Wend
    
    
    linha = 2
    While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
    
    If linha = 2 Then
    
    If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha, 1) Then
    
    col = 1
    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
    
    col = col + 1
    
    Wend
    
    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
    End If
    
    
    End If
    
    If linha > 2 Then
    linha2 = 2
    While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
    
    linha2 = linha2 + 1
    Wend
    If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
    
    col = 1
    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
    
    col = col + 1
    
    Wend
    
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
    End If
    
    
    End If
    linha = linha + 1
    
    Wend
    
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 domingo, 3 de setembro de 2017 22:58
    domingo, 3 de setembro de 2017 22:58
  • Option Explicit
    
    Sub TESTE()
    Dim linha As Long
    Dim linha2 As Long
    Dim col As Long
    linha = 2
    Sheets("sheet3").Cells.Clear
    While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
    If linha = 2 Then
    ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
    ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
    
    Else
    linha2 = 2
    While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
    
    linha2 = linha2 + 1
    Wend
    linha2 = linha2 - 1
    If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
    
    col = 1
    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
    
    col = col + 1
    
    Wend
    
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
    End If
    
    
    End If
    linha = linha + 1
    
    Wend
    
    
    linha = 2
    While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
    
    If linha = 2 Then
    
    If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha, 1) Then
    
    col = 1
    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
    
    col = col + 1
    
    Wend
    
    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
    End If
    
    
    End If
    
    If linha > 2 Then
    linha2 = 2
    While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
    
    linha2 = linha2 + 1
    Wend
    If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
    
    col = 1
    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
    
    col = col + 1
    
    Wend
    
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
    End If
    
    
    End If
    linha = linha + 1
    
    Wend
    
    End Sub


    Anderson Diniz

    Anderson,

    Muito obrigada pela resposta. Que grande ajuda!!!

    Gostei muito da sua forma. Achei que tinha que colocar a informação da primeira linha para conseguir fazer um ciclo. No entanto, estive a simular com o exemplo que dei e só funcionou para a primeira letra (A). 

    Será que me consegue ajudar no passo seguinte?

    E, uma vez que eu pensei noutra forma, acha que é possível na sheet3, na coluna B / coluna 2, obter o somatório dos valores para cada linha?

    Tabela 3
    S & D sum                
    A -3 L -10      M -12      N -2     L 21
    B 9 O -3      M 12  
    C 0 P -5      N 5  
    D 0 Q -4      O 4  
    E 0 R -1      P 1  
    F 0 S -1      T -2      Q 3  
    G 3 R 3  
    H 3 S 3  
    I 3 T 3  
     

    Obrigadíssima pela ajuda!

    Aproveito para pedir desculpa pelo atraso da resposta mas achei que receberia um alerta.


    quarta-feira, 6 de setembro de 2017 15:49
  • Option Explicit
    
    Sub TESTE()
        Dim linha As Long
        Dim linha2 As Long
        Dim col As Long
        Dim linha3 As Long
        
        Sheets("sheet3").Cells.Clear
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
            If linha = 2 Then
                ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
            If linha = 2 Then
                
                If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                    
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                End If
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                'linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        Columns("B:B").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D"
        ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum"
        
        linha = 2
        Dim soma As Integer
        
        
        While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
            soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4)
            
            col = 6
            While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                
                If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then
                    
                    soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value
                End If
                
                col = col + 1
            Wend
            ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma
            linha = linha + 1
        Wend
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 6 de setembro de 2017 16:27
    quarta-feira, 6 de setembro de 2017 16:27
  • Option Explicit
    
    Sub TESTE()
        Dim linha As Long
        Dim linha2 As Long
        Dim col As Long
        Dim linha3 As Long
        
        Sheets("sheet3").Cells.Clear
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
            If linha = 2 Then
                ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
            If linha = 2 Then
                
                If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                    
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                End If
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                'linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        Columns("B:B").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D"
        ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum"
        
        linha = 2
        Dim soma As Integer
        
        
        While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
            soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4)
            
            col = 6
            While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                
                If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then
                    
                    soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value
                End If
                
                col = col + 1
            Wend
            ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma
            linha = linha + 1
        Wend
    End Sub


    Anderson Diniz

    Anderson,

    Obrigadíssima! Está muito bom!

    A única coisa que não está a captar são as letras "Destiny" que não há na sheet1 (Tabela 2 - sheet 2).

    Fica assim:

    S & D Sum
    A -3 L -10 M -12 N -2 L 21
    B 9 O -3 M 12
    C 0 P -5 N 5
    D 0 Q -4 O 4
    E 0 R -1 P 1
    F -3 S -1 T -2
    T 0 3

    Falta apenas entender isto da tabela 2.

    G R 3
    H S 3
    H T 3

    Peço desculpa pelo pedido mas infelizmente não sei programar isto e preciso de encontrar dados de muitas linhas.

    Mais uma vez obrigada!

    quarta-feira, 6 de setembro de 2017 18:23
  • Option Explicit
    
    Sub TESTE()
        Dim linha As Long
        Dim linha2 As Long
        Dim col As Long
        Dim linha3 As Long
        
        Sheets("sheet3").Cells.Clear
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
            If linha = 2 Then
                ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
            If linha = 2 Then
                
                If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                    
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                End If
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                'linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                Else
                    Dim LINHA4 As Long
                    Dim ACHOU As Boolean
                    ACHOU = False
                    LINHA4 = 2
                    While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) <> ""
                        
                        If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                            ACHOU = True
                        End If
                        LINHA4 = LINHA4 + 1
                        
                    Wend
                    
                    If ACHOU = True Then
                        
                        linha3 = 2
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        col = 1
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            col = col + 1
                            
                        Wend
                        
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    Else
                        
                        linha3 = 2
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                            
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                        
                    End If
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        Columns("B:B").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D"
        ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum"
        
        linha = 2
        Dim soma As Integer
        
        
        While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
            soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4)
            
            col = 6
            While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                
                If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then
                    
                    soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value
                End If
                
                col = col + 1
            Wend
            ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma
            linha = linha + 1
        Wend
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 6 de setembro de 2017 19:13
    quarta-feira, 6 de setembro de 2017 19:13
  • Option Explicit
    
    Sub TESTE()
        Dim linha As Long
        Dim linha2 As Long
        Dim col As Long
        Dim linha3 As Long
        
        Sheets("sheet3").Cells.Clear
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
            If linha = 2 Then
                ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
            If linha = 2 Then
                
                If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                    
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                End If
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 4) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                'linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                Else
                    Dim LINHA4 As Long
                    Dim ACHOU As Boolean
                    ACHOU = False
                    LINHA4 = 2
                    While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) <> ""
                        
                        If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                            ACHOU = True
                        End If
                        LINHA4 = LINHA4 + 1
                        
                    Wend
                    
                    If ACHOU = True Then
                        
                        linha3 = 2
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        col = 1
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            col = col + 1
                            
                        Wend
                        
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    Else
                        
                        linha3 = 2
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                            
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                        
                    End If
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        Columns("B:B").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D"
        ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum"
        
        linha = 2
        Dim soma As Integer
        
        
        While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
            soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4)
            
            col = 6
            While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                
                If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then
                    
                    soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value
                End If
                
                col = col + 1
            Wend
            ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma
            linha = linha + 1
        Wend
    End Sub


    Anderson Diniz

    Anderson,

    A tabela 1 e a tabela 2 têm o último comum "F" e o resultado correspondente ao "F" da tabela 2 não aparece na linha certa mas sim na linha de baixo.

    Há forma de contornar? 

    Obrigada!

    S & D Sum
    A -3 L -10 M -12 N -2 L 21
    B 9 O -3 M 12
    C 0 P -5 N 5
    D 0 Q -4 O 4
    E 0 R -1 P 1
    F -3 S -1 T -2
    Q 0 3
    G 3 R 3
    H 3 S 3
    H 3 T 3


    quarta-feira, 6 de setembro de 2017 19:24
  • Anderson,

    Para eu perceber o código, é possível descrever alguns passos para a procura da informação e para a cópia na sheet3?

    Com os meus conhecimentos básicos, apenas consigo entender alguns passos.

     

    Muito obrigada pela GRANDE ajuda e pelo tempo dispensado comigo. Valeu mesmo! 

    quarta-feira, 6 de setembro de 2017 22:24
  • Option Explicit
    
    Sub TESTE()
        Dim linha As Long
        Dim linha2 As Long
        Dim col As Long
        Dim linha3 As Long
        
        Sheets("sheet3").Cells.Clear
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet1").Cells(linha, 1) <> ""
            If linha = 2 Then
                ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                ThisWorkbook.Sheets("sheet3").Cells(linha, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet1").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                Else
                    linha3 = 2
                    While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> ""
                        
                        
                        linha3 = linha3 + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet1").Cells(linha, 1)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet1").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet1").Cells(linha, 3)
                    
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        
        linha = 2
        
        
        While ThisWorkbook.Sheets("sheet2").Cells(linha, 1) <> ""
            If linha = 2 Then
                
                If ThisWorkbook.Sheets("sheet3").Cells(linha, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                    
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                End If
            Else
                linha2 = 2
                While ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) <> ""
                    
                    linha2 = linha2 + 1
                Wend
                'linha2 = linha2 - 1
                If ThisWorkbook.Sheets("sheet2").Cells(linha, 1) = ThisWorkbook.Sheets("sheet3").Cells(linha2, 1) Then
                    
                    col = 1
                    While ThisWorkbook.Sheets("sheet3").Cells(linha2, col) <> ""
                        
                        col = col + 1
                        
                    Wend
                    
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                    ThisWorkbook.Sheets("sheet3").Cells(linha2, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    
                Else
                    Dim LINHA4 As Long
                    Dim ACHOU As Boolean
                    ACHOU = False
                    LINHA4 = 2
                    
                    While ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 4) <> ""
                        
                        If ThisWorkbook.Sheets("sheet1").Cells(LINHA4, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                            ACHOU = True
                        End If
                        LINHA4 = LINHA4 + 1
                        
                    Wend
                    
                    If ACHOU = True Then
                        
                        linha3 = 2
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        col = 1
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 4) <> ""
                            
                            col = col + 1
                            
                        Wend
                        
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                        ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                    Else
                        
                        linha3 = 2
                        Dim ACHADO As Boolean
                        ACHADO = False
                        While ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) <> "" And ACHADO = False
                            If ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1) Then
                                ACHADO = True
                                col = 1
                                While ThisWorkbook.Sheets("sheet3").Cells(linha3, col) <> ""
                                    
                                    col = col + 1
                                    
                                Wend
                                
                                ThisWorkbook.Sheets("sheet3").Cells(linha3, col) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                                ThisWorkbook.Sheets("sheet3").Cells(linha3, col + 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                            End If
                            
                            linha3 = linha3 + 1
                            
                        Wend
                        If ACHADO = False Then
                            ThisWorkbook.Sheets("sheet3").Cells(linha3, 1) = ThisWorkbook.Sheets("sheet2").Cells(linha, 1)
                            ThisWorkbook.Sheets("sheet3").Cells(linha3, 2) = ThisWorkbook.Sheets("sheet2").Cells(linha, 2)
                            ThisWorkbook.Sheets("sheet3").Cells(linha3, 3) = ThisWorkbook.Sheets("sheet2").Cells(linha, 3)
                        End If
                    End If
                End If
                
                
            End If
            linha = linha + 1
            
        Wend
        
        ThisWorkbook.Sheets("sheet3").Columns("B:B").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        ThisWorkbook.Sheets("sheet3").Cells(1, 1) = "S & D"
        ThisWorkbook.Sheets("sheet3").Cells(1, 2) = "Sum"
        
        linha = 2
        Dim soma As Integer
        
        
        While ThisWorkbook.Sheets("sheet3").Cells(linha, 1) <> ""
            
            If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, 4)) Then
                soma = ThisWorkbook.Sheets("sheet3").Cells(linha, 4)
            End If
            col = 6
            While ThisWorkbook.Sheets("sheet3").Cells(linha, col) <> ""
                
                If IsNumeric(ThisWorkbook.Sheets("sheet3").Cells(linha, col)) Then
                    
                    soma = soma + ThisWorkbook.Sheets("sheet3").Cells(linha, col).Value
                End If
                
                col = col + 1
            Wend
            ThisWorkbook.Sheets("sheet3").Cells(linha, 2).Value = soma
            linha = linha + 1
        Wend
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quinta-feira, 7 de setembro de 2017 02:47
    • Marcado como Resposta R principiante terça-feira, 12 de setembro de 2017 17:54
    quinta-feira, 7 de setembro de 2017 02:46
  • Funcionou!!!

    Anderson,

    Muito obrigada! Nunca teria conseguido sem a sua GRANDE ajuda. 

    Agora vou aplicar ao meu trabalho. Espero conseguir! 

    Até uma próxima!

    quinta-feira, 7 de setembro de 2017 13:50