Sub Макрос1()
    Dim source As String, dest As String
  source = Range("DI2").Text
   dest = ChangeTextCharset(source, "Windows-1251", "UTF-8")
     MsgBox "Ðåçóëüòàò ïåðåêîäèðîâêè: """ & dest & """", vbInformation, "Èñõîäíàÿ ñòðîêà: """ & source & """"
End Sub

Function ChangeFileCharset(ByVal filename$, ByVal DestCharset$, Optional ByVal SourceCharset$) As Boolean
    On Error Resume Next: Err.Clear
     With CreateObject("ADODB.Stream")
         .Type = 2
         If Len(SourceCharset$) Then .Charset = SourceCharset$
        .Open
         .LoadFromFile filename$
        FileContent$ = .ReadText
        .Close
         .Charset = DestCharset$
        .Open
         .WriteText FileContent$
         .SaveToFile filename$, 2
        .Close
     End With
     ChangeFileCharset = Err = 0
End Function

Function ChangeTextCharset(ByVal txt$, ByVal DestCharset$, Optional ByVal SourceCharset$) As String
    On Error Resume Next: Err.Clear
     With CreateObject("ADODB.Stream")
         .Type = 2: .Mode = 3
         If Len(SourceCharset$) Then .Charset = SourceCharset$
        .Open
         .WriteText txt$
         .Position = 0
         .Charset = DestCharset$
        ChangeTextCharset = .ReadText
         .Close
     End With
End Function