Este fórum está sendo desativado

[Bantunes]

Bom dia, amiguinhos. Hoje tenho mais uma dúvida para tirar com vocês. Eu criei uma MACRO de cadastro de erro, porém, estou com problemas na parte de data. A MACRO deveria "GRAVA" os dados e coloca automaticamente o dia que as informações foram inseridas. Até aí ela faz, mas, com um problema. A MACRO altera as data anteriores para atual.

EX.: Coloquei uma informação dia 10/01/2020, se eu coloca uma nova hoje 11/01/2020 ele grava a nova data, e também altera do outro registro do dia anterior.

Código: Selecionar todos

Private Sub Gravar_Click()

'Ativar a primeira planilha
ThisWorkbook.Worksheets("Database").Activate
'Selecionar a célula A4
Range("A4").Select

'Procurar a primeira célula vazia
Do
  If Not (IsEmpty(ActiveCell)) Then
      ActiveCell.Offset(1, 0).Select
  End If
Loop Until IsEmpty(ActiveCell) = True

'Não gravar com os espaçoes em branco
If TexBox1.Text = "" Or ComboBox1.Text = "" Or ComboBox2.Text = "" Or ComboBox3.Text = "" Or ComboBox4.Text = "" Or TextBox2.Text = "" Then
    MsgBox "PREENCHIMENTO OBRIGATÓRIO DE TODOS OS CAMPOS", vbExclamation, "AVISO"
    Exit Sub
End If

'Carregar os dados digitados nas caixas de texto para a planilha
ActiveCell.Copy
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[7])"
x = Range("F1").Value
ActiveCell.Offset(0, 1).Value = TexBox1.Value
ActiveCell.Offset(0, 2).Value = ComboBox1.Value
ActiveCell.Offset(0, 3).Value = ComboBox2.Value
ActiveCell.Offset(0, 4).Value = ComboBox3.Value
ActiveCell.Offset(0, 5).Value = x
ActiveCell.Offset(0, 6).Value = ComboBox4.Value
ActiveCell.Offset(0, 7).Value = "=TODAY()"
ActiveCell.Copy
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
ActiveCell.Offset(0, 8).Value = TextBox2.Value

MsgBox "Dados registrados com sucesso!!!"

ActiveWorkbook.Save

'Limpar as caixas de texto
TexBox1.Value = Empty
ComboBox1.Value = Empty
ComboBox2.Value = Empty
ComboBox3.Value = Empty
ComboBox4.Value = Empty
TextBox2.Value = Empty

'Colocar o foco na primeira caixa de texto
TexBox1.SetFocus


End Sub
Private Sub Limpar_Click()

'Limpar as caixas de texto
TexBox1.Value = Empty
ComboBox1.Value = Empty
ComboBox2.Value = Empty
ComboBox3.Value = Empty
ComboBox4.Value = Empty
TextBox2.Value = Empty

'Colocar o foco na primeira caixa de texto
TexBox1.SetFocus

End Sub
Private Sub CommandButton4_Click()
Unload Me
UserForm2.Show
End Sub

Private Sub MultiPage1_Change()

End Sub

Private Sub Sair_Click()

ThisWorkbook.Close (True)
'ThisWorkbook.Close False
'ActiveWorkbook.Save
'Application.Quit

End Sub


'Bloquear (X) para fechar a planilha por formulario (Userform)
Private Sub UserForm_QueryClose _
   (Cancel As Integer, CloseMode As Integer)
   If CloseMode = vbFormControlMenu Then
        MsgBox "Preencha os dados e clique em Gravar, ou aperte em Sair", vbCritical, "AVISO"
        Cancel = True
   End If
End Sub

[WagnerMorel]

Bantunes,

Bom dia!

Sugiro anexar seu arquivo.