Sub CreateMarkdown()
    Dim Sh As Worksheet, FileName$, folder$, strUnicode$
    Set Sh = ThisWorkbook.Worksheets("Лист1")
    LastRow = Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row
    folder$ = ThisWorkbook.Path & "\1"

    dx = Sh.Range("B1").Resize(LastRow, 2)
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(folder$) Then
            .CreateFolder folder$
        End If

        For n = 1 To UBound(dx)
            strUnicode$ = dx(n, 2)
            FileName$ = dx(n, 1)
            If FileName$ <> "" Then
                FileName$ = .BuildPath(folder, FileName) & ".md"
                Writer_To strUnicode, FileName
            End If


        Next

    End With



End Sub

Sub Writer_To(strUnicode As String, FileName As String)

    Const adTypeBinary = 1
    Const adTypeText = 2
    Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject")
    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
    oTo.Type = adTypeText
    oTo.Charset = sTo
    oTo.Open
    oTo.WriteText strUnicode
    oTo.SaveToFile sTFSpec
    oTo.Close
    Set oFS = Nothing
    Set oTo = Nothing
End Sub
' Writer_SkipBOM запись без BOM , выберите нужную процедуру
Sub Writer_SkipBOM(strUnicode As String, FileName As String)
    Const adTypeBinary = 1
    Const adTypeText = 2
    Dim oFS: Set oFS = CreateObject("Scripting.FileSystemObject")
    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
    oTo.Type = adTypeText
    oTo.Charset = sTo
    oTo.Open
    oTo.WriteText strUnicode
    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
    BinaryStream.SaveToFile sTFSpec, 2
    BinaryStream.Close
    
Set oTo = Nothing
Set BinaryStream = Nothing

End Sub