=ЕСЛИ(BH4>100;ТЕКСТ(BH4;"0,00");ТЕКСТ(BH4;"0,0000"))

Function СцепитьЭлемМассива(Массив)   
Rem Ввод формулы: Ctrl+Shift+Enter   
   If IsArray(Массив) Then   
       СцепитьЭлемМассива = Join(Массив, "")   
   Else   
       СцепитьЭлемМассива = Массив   
   End If   
End Function

Sub xmltoxl()
    Dim f As String
    Dim wbk As Workbook
    Dim s As Integer
    Dim tBook As Workbook
    Dim MySht As Worksheet
    
    Set tBook = ThisWorkbook
    Set MySht = tBook.Sheets(1)
    MySht.Cells.ClearContents
    
    f = Dir("C:\Users\merk\Desktop\Exc12" & "\*.xml")
    s = 0
    
    Do While Len(f) > 0
        Set wbk = Workbooks.OpenXML("C:\Users\merk\Desktop\Exc12" & "\" & f)
        If s = 0 Then
           wbk.Sheets(1).Cells.Copy Destination:=MySht.Cells
           LastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           MySht.Range("Z1:Z" & LastRow) = f
        Else
           LastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           NextRow = LastRow + 1
           
           wbkLastRow = wbk.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
           
           wbk.Sheets(1).Rows("1:" & wbkLastRow).Copy Destination:=MySht.Rows(NextRow)
           
           NewLastRow = MySht.Range("A" & Rows.Count).End(xlUp).Row
           MySht.Range("Z" & NextRow & ":Z" & NewLastRow) = f
        End If
        MySht.Columns("Z").Cut
        MySht.Columns("A").Insert
        
        s = s + 1
        wbk.SaveAs Filename:="C:\Users\merk\Desktop\Exc12" & s & ".csv"
        wbk.Close False
        f = Dir()
    Loop

End Sub