Sub CreaeteModifiedXML()

    Dim new_xml As DOMDocument60
    Dim xml As DOMDocument60
    Dim nodes_all As IXMLDOMNodeList
    Dim node_all_new As IXMLDOMNode
    Dim node_product As IXMLDOMNode
    Dim nodes_prices As IXMLDOMNodeList
    Dim node_price As IXMLDOMNode
    Dim node_all As IXMLDOMNode
    Dim new_node As IXMLDOMNode
    Dim node As IXMLDOMNode
    Dim sProductName$, sXmlFile$
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\"
        With .Filters
            .Clear
            .Add "Файлы XML", "*.xml"
        End With
        If .Show() Then sXmlFile = .SelectedItems(1) Else Exit Sub
    End With

    Set new_xml = New MSXML2.DOMDocument60
    Set node = new_xml.appendChild(new_xml.createElement("ОТЧЕТ"))
    Set node = node.appendChild(new_xml.createElement("ОтчетПоТовару"))
    Set node_all_new = node.appendChild(new_xml.createElement("Все"))
    
    Set xml = New MSXML2.DOMDocument60
    xml.async = False
    xml.Load sXmlFile
    
    Set nodes_all = xml.SelectNodes("/ОТЧЕТ/ОтчетПоТовару/Все")
    For Each node_all In nodes_all
        sProductName = node_all.ChildNodes(0).Text
        Set nodes_prices = node_all.SelectNodes("Стоимость")
        For Each node_price In nodes_prices
            Set node_product = node_all_new.appendChild(new_xml.createElement("Товар"))
            node_all_new.appendChild node_product
            Set node = node_product.appendChild(new_xml.createElement("Название"))
            node.Text = sProductName
            Set node = node_product.appendChild(new_xml.createElement("Стоимость"))
            node.Text = node_price.Text
        Next
    Next
    
    new_xml.Save ThisWorkbook.Path & "\XML_MODIFIED.xml"

    MsgBox "Готово"

End Sub