O código abaixo deve funcionar, basta adicioná-lo ao código VBA para a planilha onde você insere todos os dados. Existem algumas coisas que você precisará configurar
- Uma nova planilha chamada "Dados"
- Nesta nova planilha, você precisará adicionar colunas com os títulos HISTA1, HISTA2, HISTA3 etc.
- Você precisará definir essas colunas como intervalos nomeados com o mesmo nome do cabeçalho que você forneceu (no código, subi para 6 colunas, mas você pode adicionar linhas extras ao código se precisar de mais
-
Para as células B1, B2, B3 etc na folha de registro, você precisará adicionar listas de validação de dados e fazer referência ao intervalo nomeado correto. Por exemplo, na célula B1, o intervalo seria "= HISTA1"
Private Sub Worksheet_Change(ByVal Target As Range) Dim a, b, c, d, e, f, x, newval, hist As Long Dim data As Worksheet Set data = ThisWorkbook.Worksheets("Data") Set ws = ThisWorkbook.ActiveSheet If Intersect(Target, Range("A:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub x = Target.Row newval = Target.Value Application.EnableEvents = False Application.Undo hist = Target.Value y = data.Cells(Rows.Count, x).End(xlUp).Row data.Cells(y + 1, x).Value = hist Target.Value = newval a = data.Range("A" & Rows.Count).End(xlUp).Row b = data.Range("B" & Rows.Count).End(xlUp).Row c = data.Range("C" & Rows.Count).End(xlUp).Row d = data.Range("D" & Rows.Count).End(xlUp).Row e = data.Range("E" & Rows.Count).End(xlUp).Row f = data.Range("F" & Rows.Count).End(xlUp).Row ActiveWorkbook.Names("HISTA1").Delete ActiveWorkbook.Names("HISTA2").Delete ActiveWorkbook.Names("HISTA3").Delete ActiveWorkbook.Names("HISTA4").Delete ActiveWorkbook.Names("HISTA5").Delete ActiveWorkbook.Names("HISTA6").Delete ActiveWorkbook.Names.Add Name:="HISTA1", RefersTo:="=Data!$A$2:$A$" & a ActiveWorkbook.Names.Add Name:="HISTA2", RefersTo:="=Data!$B$2:$B$" & b ActiveWorkbook.Names.Add Name:="HISTA3", RefersTo:="=Data!$C$2:$C$" & c ActiveWorkbook.Names.Add Name:="HISTA4", RefersTo:="=Data!$D$2:$D$" & d ActiveWorkbook.Names.Add Name:="HISTA5", RefersTo:="=Data!$E$2:$E$" & e ActiveWorkbook.Names.Add Name:="HISTA6", RefersTo:="=Data!$F$2:$F$" & f Application.EnableEvents = True End Sub
Eu baseei o código no seu exemplo, mas se as referências da célula forem diferentes, o código precisará ser alterado, pois a linha de entrada está vinculada à coluna do histórico.
Qualquer dúvida ou problema, fico feliz em ajudar.