Merge cells without losing values


The cells from column A and B are to be merged without losing the values from column B

Sub Connects()
   Dim intRow As Integer
   Dim txt As String
   intRow = 1
   Do Until IsEmpty(Cells(intRow, 1))
      Cells(intRow, 1) = Cells(intRow, 1) & " - " & Cells(intRow, 2)
      Cells(intRow, 2).ClearContents
      Range(Cells(intRow, 1), Cells(intRow, 2)).Merge
      intRow = intRow + 1
   Loop
   Columns(1).AutoFit
End Sub