Sub Просто()
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    Set objNode = xmlDoc.createProcessingInstruction( _
                "xml", "version=""1.0"" encoding=""utf-8"" standalone=""yes""")
    Set objNode = xmlDoc.InsertBefore(objNode, xmlDoc.ChildNodes.Item(0))
    Set Comments = xmlDoc.createComment("generated by BeerukoffNotariat " & Mid(ActiveWindow.Caption, 20, 3))
    xmlDoc.InsertBefore Comments, NotificationData
    Set PledgeNotificationToNotary = xmlDoc.createElement("PledgeNotificationToNotary")
    Set xmlDoc.DocumentElement = PledgeNotificationToNotary
    PledgeNotificationToNotary.setAttribute "xmlns", "http://dev.triasoft.com/schemas/eis/eregistry/pppr/2.0"
    PledgeNotificationToNotary.setAttribute "version", "2.0"
    Set NotificationData = xmlDoc.createElement("NotificationData")
    NotificationData.setAttribute "version", "2.0"
    PledgeNotificationToNotary.appendChild NotificationData
    ПоискЗначенияКода "ТипУведомления", "Форма"
    Set FormTip = xmlDoc.createElement(ЗначениеКода)
    NotificationData.appendChild FormTip

'Залогодатель
    Set Pledgee1 = xmlDoc.createElement("Pledgee")
    FormTip.appendChild Pledgee1
    Set Pledgee2 = xmlDoc.createElement("Pledgee")
    Pledgee1.appendChild Pledgee2
    Set PledgeeOrganization = xmlDoc.createElement("Organization")
    Pledgee2.appendChild PledgeeOrganization
    Set PledgeeRussianOrganization = xmlDoc.createElement("RussianOrganization")
    PledgeeOrganization.appendChild PledgeeRussianOrganization
    Set NameFull = xmlDoc.createElement("NameFull")
    ПоискЗначенияКода "НаименованиеБанка", "Настройки"
    NameFull.Text = ЗначениеКода
    PledgeeRussianOrganization.appendChild NameFull
    Set OGRN = xmlDoc.createElement("OGRN")
    ПоискЗначенияКода "ОГРНБанка", "Настройки"
    OGRN.Text = ЗначениеКода
    PledgeeRussianOrganization.appendChild OGRN
    Set INN = xmlDoc.createElement("INN")
    ПоискЗначенияКода "ИННБанка", "Настройки"
    INN.Text = ЗначениеКода
    PledgeeRussianOrganization.appendChild INN
    Set PledgeeRussianOrganizationAddress = xmlDoc.createElement("Address")
    PledgeeRussianOrganization.appendChild PledgeeRussianOrganizationAddress
    Set RegionCode = xmlDoc.createElement("RegionCode")
    ПоискЗначенияКода "КодСубъектаБанка", "Настройки"
    RegionCode.Text = ЗначениеКода
    PledgeeRussianOrganizationAddress.appendChild RegionCode
    Set Region = xmlDoc.createElement("Region")
    ПоискЗначенияКода "НаименованиеСубъектаБанка", "Настройки"
    Region.Text = ЗначениеКода
    PledgeeRussianOrganizationAddress.appendChild Region
    Set City = xmlDoc.createElement("City")
    ПоискЗначенияКода "ГородБанка", "Настройки"
    City.Text = ЗначениеКода
    PledgeeRussianOrganizationAddress.appendChild City
    Set Street = xmlDoc.createElement("Street")
    ПоискЗначенияКода "УлицаБанка", "Настройки"
    Street.Text = ЗначениеКода
    PledgeeRussianOrganizationAddress.appendChild Street
    Set House = xmlDoc.createElement("House")
    ПоискЗначенияКода "ДомБанка", "Настройки"
    House.Text = ЗначениеКода
    PledgeeRussianOrganizationAddress.appendChild House
    Set Email = xmlDoc.createElement("Email")
    ПоискЗначенияКода "EmailБанка", "Настройки"
    Email.Text = ЗначениеКода
    PledgeeRussianOrganization.appendChild Email
  
ОформлениеXML xmlDoc, vbCrLf

    strFilePath = ThisWorkbook.Path & "\Test.xml"
    xmlDoc.Save strFilePath
End Sub

Private Sub ПоискЗначенияКода(Код As String, Лист As String)
With Worksheets(Лист).Columns("K:K")
    Set Результат = .Find(What:=Код, LookIn:=xlValues)
    If Not Результат Is Nothing Then
        firstAddress = Результат.Address 'запоминаем адресс первой найденой ячейки
        Do
        If Sheets(Лист).Cells(Результат.Row, Результат.Column + 1) <> "" Then ЗначениеКода = Sheets(Лист).Cells(Результат.Row, Результат.Column + 1) Else ЗначениеКода = Sheets(Лист).Cells(Результат.Row, Sheets(Лист).Cells(Результат.Row, Результат.Column + 2))
            Set Результат = .FindNext(Результат) 'ищем следующую
        Loop While Not Результат Is Nothing And Результат.Address <> firstAddress 'выход из цикла при переходе снова на перую
    End If
End With
End Sub

Private Sub ОформлениеXML(node, levelIndent As String)
    Dim objNewText, child
    Dim bolExit As Boolean

    ' если нет дочерних нодов, то выходим
    If Not node.HasChildNodes Then Exit Sub
    ' перебираем все дочерние ноды и добавляем перед каждым отступ
    Set child = node.FirstChild
    Do Until child Is Nothing
        If child.NodeType = 1 Then
          ' отступ перед открывающим тегом
          If Not node.OwnerDocument Is Nothing Then
             Set objNewText = node.OwnerDocument.createTextNode(levelIndent)
             node.InsertBefore objNewText, child
          End If
          ' отступ перед закрывающим тегом
          If child.ChildNodes.Item(0).NodeType <> 3 Then   ' отступ перед закрывающим тегом Node_Text не нужен
             If Not node.OwnerDocument Is Nothing Then
                Set objNewText = node.OwnerDocument.createTextNode(levelIndent)
             Else
                Set objNewText = node.createTextNode(levelIndent)
             End If
             child.appendChild (objNewText)
          End If
          ' запускаем рекурсию для дочерних нодов текущего нода
          ОформлениеXML child, levelIndent & "  "
        End If
        ' переходим к следующему ноду вниз по дереву от текущего
        Set child = child.NextSibling
    Loop
End Sub