Sub YML_For_Professional()
    On Error Resume Next
    xmlpath$ = ThisWorkbook.Path & "\WebXml.xml"
    Set XML = CreateObject("Microsoft.XMLDOM")

    Dim ra As Range, cell As Range
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))    ' заполненные строки

    ' задаем кодировку для XML
    XML.appendChild XML.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")

    With XML.appendChild(XML.createElement("pma_xml_export"))
        .Attributes.setNamedItem(XML.createAttribute("version")).Text = "1.0"
        With .appendChild(XML.createElement("databas"))
            .Attributes.setNamedItem(XML.createAttribute("name")).Text = "loginuser"
            ' добавляем дочерние узлы для каждой строки
            For Each cell In ra.Cells    ' перебираем все строки
                With .appendChild(XML.createElement("table"))    ' создаём узел в XML
                    ' и добавляем в него значения
                    .Attributes.setNamedItem(XML.createAttribute("name")).Text = "WebXml"
                    For i = 1 To 4    ' для каждого столбца
                        With .appendChild(XML.createElement("column"))    ' к элементу column
                            ColumnName$ = Cells(1, i)    'дописываем атрибут name
                            .Attributes.setNamedItem(XML.createAttribute("name")).Text = ColumnName$
                            .Text = cell.EntireRow.Cells(i)    'и присваиваем значение
                        End With
                    Next
                End With
            Next cell
        End With
    End With

    XML.Save xmlpath$    ' сохраняем XML
End Sub