Sub Change_Value_to_Next_Cell_GOOD()
  Dim aRng As Range
  Dim sText As String
  sText = InputBox("Enter text to move cell")
  Set aRng = ActiveDocument.Range
  ActiveWindow.View = wdNormalView
  Application.ScreenUpdating = False
  With aRng.Find
    .ClearFormatting
    .Text = sText
    .Wrap = wdFindStop
    Do While .Execute
      If aRng.Information(wdWithInTable) Then
        aRng.Cells(1).Next.Range.FormattedText = aRng.FormattedText
        aRng.Delete
        aRng.MoveStart Unit:=wdCell, Count:=2
      End If
    Loop
  End With
  Application.ScreenUpdating = True
  MsgBox " You're Selection is Done in the Active Document!"
End Sub