VBA - Insert data in different cells without interruption - excel

Question

I have a worksheet, in this I would like to fill different cells by an input.
Currently it works by clicking in the cell. However, you have to click on each cell individually.
Now I want that when I confirm the input in the first cell, the input for the second value appears directly and so I can fill up to 5 values in a row without clicking each time.
So i click a button it should open a input dialog, there i insert my input, then it appears in the first cell, without closing it changes to second input dailog, where i insert my input again ....
Here my code of the currect solution.
I hope u understand and can help me with this function
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim varEintrag
If Target.Cells(1).Address(0, 0) = "D12" Then
varEintrag = Application.InputBox("Bitte Wert eintragen", "Dateneingabe")
If varEintrag <> "Falsch" And varEintrag <> "False" Then
If IsNumeric(varEintrag) Then
Target = CDbl(varEintrag)
Else
Target = varEintrag
End If
End If
End If
End Sub```

Answer 1

Trigger Multiple Cells Entry
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ClearError
Const iAddress As String = "D12"
Const mrgAddress As String = "D12,E12,D13,D15,E15"
Dim iCell As Range
Set iCell = Intersect(Range(iAddress), Target)
If iCell Is Nothing Then Exit Sub
Dim mrg As Range: Set mrg = Range(mrgAddress)
Application.EnableEvents = False
Dim varEintrag As Variant
For Each iCell In mrg.Cells
varEintrag = Application.InputBox( _
Prompt:="Bitte Wert in Zelle '" & iCell.Address(0, 0) _
& "' eintragen:", _
Title:="Dateneingabe", _
Default:=iCell.Value)
If varEintrag <> "Falsch" And varEintrag <> "False" Then
If IsNumeric(varEintrag) Then
iCell.Value = CDbl(varEintrag)
Else
iCell.Value = varEintrag
End If
Else
Exit For ' Cancel
End If
Next iCell
SafeExit:
If Not Application.EnableEvents Then Application.EnableEvents = True
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub

Answer 2

Please, try this modified event. It consecutively asks about the 5 necessary inputs and then place them in the necessary range:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim varEintrag, arrE(4), i As Long, k As Long
If Target.Rows.count > 1 Or Target.Columns.count > 1 Then Exit Sub
If Target.cells(1).Address(0, 0) = "D12" Then
Dim rngRet As Range: Set rngRet = Range("D12, E12, D13, D15, E15")
For i = 0 To UBound(arrE)
varEintrag = Application.InputBox("Bitte Wert eintragen " & i + 1, "Dateneingabe")
If varEintrag <> "Falsch" And varEintrag <> "False" Then
If IsNumeric(varEintrag) Then
arrE(k) = CDbl(varEintrag): k = k + 1
Else
arrE(i) = varEintrag: k = k + 1
End If
End If
Next i
Dim cel As Range: k = 0
For Each cel In rngRet.cells
cel.Value = arrE(k): k = k + 1
Next
End If
End Sub
Edited:
This is a version iterating between each discontinuous range cells and ask for input in each such a cell address:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.count > 1 Or Target.Columns.count > 1 Then Exit Sub
If Target.cells(1).Address(0, 0) = "D12" Then
Dim rngRet As Range: Set rngRet = Range("D12, E12, D13, D15, E15")
Dim varEintrag, cel As Range
For Each cel In rngRet.cells
varEintrag = Application.InputBox("Bitte Wert eintragen in " & cel.Address, "Dateneingabe")
If varEintrag <> "Falsch" And varEintrag <> "False" Then
If IsNumeric(varEintrag) Then
cel.Value = CDbl(varEintrag)
Else
cel.Value = varEintrag
End If
End If
Next cel
End If
End Sub