How to Paste each list cell value in each Sheet in the same cell address VBA

How to use VBA code to paste each list cell value in each Sheet in the same cell address

Requirement:

The user has a list with values and the user wants to copy and paste each value in each sheet in the same location. The user has tried to create code and searched information but is still stuck to figure out how to do this.

Below is code.

Code:

Sub AddListValuesInSheets()

Dim xRg As Range, sh As Worksheet

On Error GoTo Quit
Set dbrange = Application.InputBox("Range: ", "Select Range", _
Application.Selection.Address, Type:=8)
    
Application.ScreenUpdating = False

For Each xRg In dbrange
    For Each sh In ActiveWorkbook.Worksheets
        sh.Range("D3").Value = xRg.Value
    Next sh
Next xRg
    
Application.ScreenUpdating = True
Quit:

End Sub

The user would like to know where is the problem? This code go through all sheets to paste the LAST cell from the list. And this is not that the user wants.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1198958-paste-each-list-cell-value-in-each-sheet-in-the-same-cell-address-vba

Solution:

Code:

Sub AddListValuesInSheets()
    Dim xRg As Range
    Dim x As Long
    x = 2
    Set dbrange = Application.InputBox("Range: ", "Select Range", Application.Selection.Address, Type:=8)
    Application.ScreenUpdating = False
    For Each xRg In dbrange
        Sheets(x).Range("D3") = xRg
        x = x + 1
    Next xRg
    Application.ScreenUpdating = True
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Mumps.