Valores não estão sendo inseridos nas células

[asafe_]

Tenho uma base de dados correspondente a um dia, ao atualizar preciso dos mesmos valores 30 vezes completando 31 dias que é o máximo de dias em um mês apenas fazendo um incremento (+1) para criar a base de dados do mês todo. Alguém tem alguma sugestão?

Aqui uma cópia do código.

Sub copiarDados()

    ' Desativar atualização de tela e ativar cálculo manual

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    

    On Error GoTo ErrorHandler

    

    Dim ws As Worksheet

    Set ws = ThisWorkbook.ActiveSheet

    

    Dim rngDados As Range

    Dim rngData As Range

    Dim celDataInicial As Range

    Dim i As Integer

    

    'Selecionar o range total de dados a partir do intervalo nomeado "linha_inicial"

    Set rngDados = ws.Range("linha_inicial").Resize(ws.Cells(ws.Rows.Count, ws.Range("linha_inicial").Column).End(xlUp).Row - ws.Range("linha_inicial").Row + 1)

    If rngDados Is Nothing Then Exit Sub

    

    'Identificar a coluna de data como a terceira coluna do intervalo de dados

    Set rngData = rngDados.Columns(3)

    

    'Selecionar a célula com a data inicial como a primeira célula da coluna de data

    Set celDataInicial = rngData.Cells(1)

    

    ' Calcular a quantidade de dias no mês da data inicial

    Dim quantidadeDias As Integer

    quantidadeDias = Day(DateSerial(Year(celDataInicial.Value), Month(celDataInicial.Value), 0))

    

    ' Calcular o número de linhas a serem inseridas (dias do mês menos um, pois o dia 1 já está no intervalo inicial de dados)

    Dim numRows As Integer

    numRows = quantidadeDias - 1

    

    ' Armazenar referência da célula inicial

    Dim celInicialOriginal As Range

    Set celInicialOriginal = celDataInicial

    

    'Loop para adicionar as cópias dos dados abaixo

    For i = 1 To numRows

        ' Armazenar dados em uma matriz

        Dim dataValues As Variant

        dataValues = rngData.Value

        

        ' Ajustar os dados na matriz

        Dim j As Integer

        For j = LBound(dataValues, 1) To UBound(dataValues, 1)

            If j = 1 Then

                ' Incrementar a data inicial

                dataValues(j, 1) = celDataInicial.Value + i

            Else

                ' Manter a mesma data para as demais células

                dataValues(j, 1) = celDataInicial.Value

            End If

        Next j

        

        ' Transferir os dados de volta para a planilha

        Dim outputRange As Range

        Set outputRange = rngData.Offset((i - 1) * rngDados.Rows.Count).Resize(UBound(dataValues, 1), UBound(dataValues, 2))

        outputRange.Value = dataValues

    Next i

    

    ' Atualizar a célula com a nova data inicial (avançar a quantidade de dias do mês)

    Set celDataInicial = celInicialOriginal.Offset(numRows)

    

    ' Reativar atualização de tela e cálculo automático

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    

    ' Mensagem de sucesso

    MsgBox "Dados atualizados."

    

    Exit Sub

    

ErrorHandler:

    ' Reativar atualização de tela e cálculo automático em caso de erro

    Application.ScreenUpdating = True

    Application.Calculation = xlCalculationAutomatic

    

    If Err.Number = 424 Then

        MsgBox "Operação cancelada pelo usuário."

    ElseIf Err.Number = 13 Then

        MsgBox "A célula selecionada como a data inicial não contém uma data válida. Operação cancelada."

    ElseIf Err.Number <> 0 Then

        MsgBox "Erro " & Err.Number & ": " & Err.Description, vbCritical

    Else

        MsgBox "Erro desconhecido."

    End If

End Sub

[Alyson Ronnan Martins]

Pelo que entendi, você deseja replicar os dados do primeiro dia para os outros 30 dias do mês, alterando apenas a data. Seu código atual já parece fazer isso. No entanto, notei que você está incrementando a data apenas na primeira linha de cada conjunto de dados copiado. Se você deseja que a data seja incrementada para todas as linhas copiadas, você deve remover a condição If j = 1 Then e sempre incrementar a data, como mostrado abaixo:

For j = LBound(dataValues, 1) To UBound(dataValues, 1)
    ' Incrementar a data inicial
    dataValues(j, 1) = celDataInicial.Value + i
Next j