Boa tarde hndrade,

Veja se o código no módulo1 do arquivo em anexo traz os resultados desejados. Os valores estarão na planilha 'Auxiliar'.

att,

Boa noite brunoxro!

Muito bom meu caro, é praticamente o que eu precisava!!

A única diferença é que na planilha original a coluna de data (201705) se repete e também não é data em sí mas sim da forma em que escrevi entre parêntesis, mas isso pode ser facilmente resolvido com um inputbox

* como está planilha não possui cabeçalho, onde eu altero no código pra que comece a lançar nas primeira linha?

A única coisa que alterei é a abrangência das colunas que estava de 9 até 23 e mudei para 3 a 23, fora isso está perfeito!

hndrade,

Teste as alterações que fiz no código:

Sub Organizar_Valores02()
    
    Dim WsLan       As Worksheet: Set WsLan = Sheets("Lançamentos")
    Dim WsAux       As Worksheet: Set WsAux = Sheets("Auxiliar")
    
    Dim i           As Double
    Dim k           As Double
    Dim Nlin        As Double
    Dim Lin         As Double
    
    Dim Matr        As String
    Dim Cod         As String
    Dim Mes         As Variant
    
    Nlin = WsLan.Range("A1048575").End(3).Row
    
    WsLan.Select
    
    Lin = WsAux.Range("A1048575").End(xlUp).Row + 1
    
    If Lin = 2 Then
        Lin = 1
    End If
    
    For i = 4 To Nlin
        
        For k = 3 To 23
            
            If Cells(i, k).Value <> Empty Then
                
                Matr = UCase(Trim(Cells(i, 1).Value))
                Cod = UCase(Trim(Cells(2, k).Value))
                
                If Month(Now) < 10 Then
                    Mes = 0 & Month(Now)
                ElseIf Month(Now) >= 10 Then
                    Mes = Month(Now)
                End If
                
                'Joga os valores para a planilha Auxiliar
                With WsAux.Cells(Lin, 1)
                    .Value = CStr("R")
                    .Offset(0, 1).Value = CByte(1)
                    
                    .Offset(0, 2).Value = Matr
                    .Offset(0, 3).Value = Cod
                    'Ano e Mês do computador
                    .Offset(0, 4).Value = Year(Now) & Mes
                    .Offset(0, 5).Value = Year(Now) & Mes
                    
                    .Offset(0, 6).Value = Cells(i, k).Value
                    
                    .Offset(0, 7).Value = CByte(0)
                    .Offset(0, 8).Value = CByte(0)
                    
                End With
                
                Lin = WsAux.Range("A1048575").End(xlUp).Row + 1
                
            End If
        
        Next k
    
    Next i
    
End Sub

Se seu problema foi resolvido, não esqueça de marcar o tópico como Respondido.

att,

Exatamente!

Muito obrigado pelo apoio!!