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
