Este fórum está sendo desativado

[Diego100ges]

Prezados, bom dia.
Ontem um colega aqui do fórum me ajudou com uma macro para organizar alguns dados, porém não funcionou 100% e acabei fechando o tópico.
O que acontece, o código roda certinho, porém, ele acaba pulando sempre a penúltima data, do intervalo, e não entendo muito de macros para corrigir sozinho, alguém consegue dar uma força?
Segue anexo para esclarecimento.

Muito obrigado!

[Jimmy]

Olá Diego,

As vezes é mais fácil desenvolver do zero, do que entender uma outra macro, e alterar.

Teste a macro NOVA

Se esta mensagem colabora para a solução do problema, peço que dê um Like, clicando no botão com o "positivo", acima e a direita.

Jimmy San Juan

[JCabral]

Veja se resolve, tendo por base a solução inicial.
A versão do Jimmy é muito mais clean.

Código: Selecionar todos

Sub OrganizarEstrutura()
    Dim UltimoRegistro As Variant
    Dim ConteudoLinhas() As Variant
    Dim Linha As Integer

    Plan1.Cells.ClearContents

    UltimoRegistro = Plan3.Cells(Plan3.Rows.Count, 1).End(xlUp).Row

    'Gravar dados em uma matriz
    ReDim ConteudoLinhas(1 To UltimoRegistro - 3, 1 To 14)

    For i = 4 To UltimoRegistro
        For j = 1 To 14
            ConteudoLinhas(i - 3, j) = Plan3.Cells(i, j).Value
        Next
    Next

    'Rodar a matriz e gravar dados na segunda planilha
    Linha = 0

    For i = 1 To UltimoRegistro - 3

Repetir:
    
        'Novo intervalo de datas
        Linha = Linha + 1
    
        'Grava uma linha
        For k = 2 To 14
            If k = 2 Then
                Plan1.Cells(Linha, 1).Value = ConteudoLinhas(i, 1)
            Else
                Plan1.Cells(Linha, k).Value = ConteudoLinhas(i, k)
            End If
        Next
    
        'Verificar se: "dia atual" + "1 dia" = Proximo registro
        If DateDiff("d", (DateAdd("d", 1, ConteudoLinhas(i, 1))), (ConteudoLinhas(i, 2))) < 0 Then
            
            'Gravar registro atual, e ir pro proximo
            For k = 2 To 14
                If k = 2 Then
                    Plan1.Cells(Linha, 1).Value = ConteudoLinhas(i, 1)
                Else
                    Plan1.Cells(Linha, k).Value = ConteudoLinhas(i, k)
                End If
            Next
            
        Else
            'Repetir o registro, adicionar um dia
            ConteudoLinhas(i, 1) = DateAdd("d", 1, ConteudoLinhas(i, 1))
            GoTo Repetir
            
        End If

    Next

End Sub

[Diego100ges]

Obrigado pela ajuda pessoal.
Funcionou perfeitamente Jimmy