Worksheets("База").Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlNo

     For r = 1 To 10
        Set f = Worksheets("База").Range("$A:$A").Find(what:=Worksheets("Форма").Range("A" & r), lookat:=xlWhole)
            If Not f Is Nothing Then
                MsgBox "Значение уже есть " & Worksheets("Форма").Range("A" & r)
                Exit Sub
            End If
     Next

Option Explicit

Sub ПереносБезПовторов()

  Dim shDest As Worksheet, shSour As Worksheet
  Set shDest = ActiveWorkbook.Worksheets("База")
  Set shSour = ActiveWorkbook.Worksheets("Форма")

  Dim sTxt As String, r As Range, x As Long
  With shSour
    For x = .UsedRange.Row To _
        .UsedRange.Row + .UsedRange.Rows.Count - 1
      Set r = shDest.Cells.Find(what:=.Cells(x, 1).Value, lookat:=xlWhole)
      If Not r Is Nothing Then _
         sTxt = sTxt & ", " & r.Value
    Next
  End With

  If Len(sTxt) > 0 Then
    MsgBox "Номера уже внесены в базу " & sTxt
  Else
    shSour.UsedRange.Copy
    
    With shDest
      .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1).PasteSpecial _
    Paste:=xlValues
    End With
    
    shSour.UsedRange.ClearContents
  End If
End Sub