Private Sub CreateXML_Click()
    On Error GoTo EH_CreateXML_Click
    
 Dim name As String
    name = "WORK " & Worksheets("table").Range("Comp").Value & ".xml"
    
 
    fileToSave = Application.GetSaveAsFilename(name, "Dokumenty XML (*.xml), *.xml")
      
      
    If fileToSave <> False Then
        Dim xml As String
        xml = GenXML()
       
        Dim fso, MyFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set MyFile = fso.CreateTextFile(fileToSave, True, True)

        MyFile.Write xml
        MyFile.Close
    Else
        MsgBox "Not chosen", vbInformation
    End If
    Exit Sub
    
EH_CreateXML_Click:
    MsgBox Err.Description, vbCritical, "Error in " & "CreateXML_Click()"
End Sub

arr = Array("подгруппа товаров БББ", "подгруппа товаров ГГГ")

arr = Array(x1, x2, x3, ..., x10)

Sub M55_DelRows2()
    Dim x As Range, y As Range, fst As String
    Set x = [B:B].Find(0, , xlValues, xlWhole)
    If Not x Is Nothing Then
        fst = x.Address
        Do
            If y Is Nothing Then Set y = x Else Set y = Union(y, x)
            Set x = [B:B].FindNext(x)
        Loop While fst <> x.Address
        y.EntireRow.Delete
    End If
End Sub

Private Sub Workbook_Open()
    Dim WB1 As Workbook
    Dim WB2 As Workbook
    Set WB1 = Application.Workbooks.Open("C:\Users\Comp\Desktop\Остатки\м.xls")
    Set WB2 = Application.Workbooks.Open("C:\Users\Comp\Desktop\Остатки\р.xls")
    Application.Wait (Now + TimeValue("00:00:03"))
    WB1.Close
    WB2.Close
    End Sub
Public Sub copyLinkedSheet()
    Dim arrLink As Variant
    Dim newBook As Workbook
    Dim sLink As Variant
    ThisWorkbook.Sheets(4).Copy
    Set newBook = Application.Workbooks(Application.Workbooks.Count)
    arrLink = newBook.LinkSources(XlLink.xlExcelLinks)
    For Each sLink In arrLink
        newBook.BreakLink sLink, xlLinkTypeExcelLinks
    Next
End Sub
Sub DelRows2()
    Dim x As Range, y As Range, fst As String
    Set x = [D:D].Find(0, , xlValues, xlWhole)
    If Not x Is Nothing Then
        fst = x.Address
        Do
            If y Is Nothing Then Set y = x Else Set y = Union(y, x)
            Set x = [D:D].FindNext(x)
        Loop While fst <> x.Address
        y.EntireRow.Delete
    End If
End Sub
Sub all()
    Call Workbook_Open
    Call copyLinkedSheet
    Call DelRows2
End Sub