Sub tt()
      Dim objOleCvt, c As Range

      Set objOleCvt = CreateObject("OlePrn.OleCvt.1")

      With objOleCvt
          For Each c In ActiveSheet.UsedRange.Columns(1).Cells
              c.Value = .ToUnicode(c.Value, 65001)
          Next
      End With

      Set objOleCvt = Nothing

End Sub

Option Explicit

Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

Public Function UTF8ToWin(ByVal inString As String) As String
         Dim hMemLock1   As Long, hMemLock2  As Long
         Dim iStrSize    As Long, lMaxSize As Long, str1 As String, str2 As String
         inString = inString & vbNullChar '& vbNullChar
         lMaxSize = Len(inString)
         str1 = String$(lMaxSize, 0&)
         str2 = String$(lMaxSize, 0&)
         hMemLock1 = StrPtr(str1)
         hMemLock2 = StrPtr(str2)
         iStrSize = MultiByteToWideChar(65001, 0&, inString, &HFFFF, hMemLock1, lMaxSize)
         iStrSize = WideCharToMultiByte(0&, 0&, hMemLock1, &HFFFF, hMemLock2, iStrSize, 0&, 0&)

         If Len(iStrSize) Then
         UTF8ToWin = StrConv(str2, vbUnicode)
         End If
End Function

Sub QWERT()
  Debug.Print UTF8ToWin("РўРёРї: Шариковая ручка")
End Sub