Sub uuu()
Dim a(), b(), c()
Dim i&, j&
Dim txt$, sFile$
'---------------------
sFile = "ваш_путь.csv"

a = ActiveSheet.UsedRange.Value

ReDim c(1 To UBound(a))

For i = 1 To UBound(a)
ReDim b(1 To UBound(a, 2))
For j = 1 To UBound(a, 2)
b(j) = Chr(34) & a(i, j) & Chr(34)
Next
c(i) = Join(b, ";")
Next

Writer_ToFile_SkipBOM sFile, Join(c, vbCrLf)

Beep
MsgBox "Готово"
End Sub

Function Writer_ToFile_SkipBOM(FileName As String, Text As String)
Const adTypeBinary = 1
Const adTypeText = 2
Const bOverwrite = True
Const bAsASCII = False
Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject")
Dim oFrom: Set oFrom = CreateObject("ADODB.Stream")
Dim sFrom: sFrom = "Windows-1251"
Dim oTo: Set oTo = CreateObject("ADODB.Stream")
Dim sTo: sTo = "utf-8"
Dim sTFSpec: sTFSpec = oFS.GetAbsolutePathName(FileName)
If oFS.FileExists(sTFSpec) Then oFS.DeleteFile sTFSpec
oFrom.Type = adTypeText
oFrom.Charset = sFrom
oFrom.Open
oTo.Type = adTypeText
oTo.Charset = sTo
oTo.Open
oTo.WriteText Text
oTo.Position = 3
Dim BinaryStream As Object
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = 1
BinaryStream.Mode = 3
BinaryStream.Open
oTo.CopyTo BinaryStream
oTo.Flush
oTo.Close
oFrom.Close
BinaryStream.SaveToFile sTFSpec, 2
BinaryStream.Close

End Function