iFullName = ThisWorkbook.path & "\тест папки\2020\" & Date &"\" & Date & ".xlsx"

Sub uuu()
    With ActiveSheet
        MsgBox .Cells(3, 2).CurrentRegion.Address
    End With
End Sub

Sub сэмэсэ()
    Dim запрос$, ответ$
    URL = "https://api.anysite.com/simple/send?phone=xxxxxxxxxxxx&text=hello+world&username=yyy&password=zzz"
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", запрос, False 'может вместо get будет post
        .send
        Do: DoEvents: Loop Until .ReadyState = 4
        ответ = .responsetext
    End With
    Beep
    MsgBox ответ
End Sub

Sub uuu()
    Dim a()
    Dim i&, lr&
'------------
    Application.ScreenUpdating = False
    a = Sheets("БД").UsedRange.Value
    For i = 3 To UBound(a) - 1
        On Error Resume Next
        With Sheets(a(i, 2))
            lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            For j = 1 To UBound(a, 2)
                .Cells(lr, j) = a(i, j)
            Next
        End With
        If Err Then Err.Clear
    Next
    Application.ScreenUpdating = True
    Beep
    MsgBox "Приехали!"
End Sub

Sub Глaбол()
    Dim a()
    Dim j&
'-----------
    a = Sheets("Шапка").UsedRange.Rows(21).Value
    With CreateObject("Scripting.Dictionary")
        For j = 1 To UBound(a, 2)
            If a(1, j) <> "" Then .Item(a(1, j)) = ""
        Next
        a = Sheets("Шапка").UsedRange.Rows(1).Value
        For j = 1 To UBound(a, 2)
            If a(1, j) <> "" Then
                If Not .Exists(a(1, j)) Then
                    MsgBox "Нет заголовка """ & a(1, j) & """"
                    Exit Sub
                End If
            End If
        Next
    End With
    Beep
    MsgBox "Всё на месте"
End Sub

Sub uuu()
    Dim a()
    Dim i&, rw&
'----------------
    Application.ScreenUpdating = False
    rw = 2
    a = Sheets("Выгрузка").UsedRange.Value
    With Sheets("Отчет")
        For i = 2 To UBound(a)
            If a(i, 1) > 0 Then
                .Cells(rw, 1) = a(i, 1)
                .Cells(rw, 3) = a(i, 3)
                rw = rw + 1
            End If
        Next
        .Activate
    End With
    Application.ScreenUpdating = True
    Beep
End Sub

Sub nnn()
    Dim a()
    Dim fl$
'---------------
    fl = ThisWorkbook.Path & "\NO_BOUPR_6617_6617_6617003362661701001_20170221_C90CAFCD7904471D8AF57A83F70E0863.xml"
    With CreateObject("MSXML2.DOMDocument")
        .Load fl
        ReDim a(1 To 7)
        a(1) = .SelectSingleNode("//Файл/Документ/СвНП").GetAttribute("ОКПО")
        a(2) = .SelectSingleNode("//Файл/Документ/Баланс/Актив").GetAttribute("СумОтч")
        a(3) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/МатВнеАкт").GetAttribute("СумОтч")
        a(4) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/НеМатФинАкт").GetAttribute("СумОтч")
        a(5) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/Запасы").GetAttribute("СумОтч")
        a(6) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/ДенежнСр").GetAttribute("СумОтч")
        a(7) = .SelectSingleNode("//Файл/Документ/Баланс/Актив/ФинВлож").GetAttribute("СумОтч")
    End With
    Cells(3, 1).Resize(1, UBound(a)) = a
End Sub

Sub uuu()
    Dim a()
    Dim nd, at
    Dim fl$
'---------------
    fl = ThisWorkbook.Path & "\NO_BOUPR_6617_6617_6617003362661701001_20170221_C90CAFCD7904471D8AF57A83F70E0863.xml"
    With CreateObject("MSXML2.DOMDocument")
        .Load fl
        ReDim a(1 To 7)
        For Each nd In .getElementsByTagName("*")
            If nd.NodeName = "СвНП" Then
                a(1) = nd.GetAttribute("ОКПО")
            Else
                For Each at In nd.Attributes
                    If at.Name = "КодСтроки" Then
                        Select Case at.Value
                            Case "1600": a(2) = nd.GetAttribute("СумОтч")
                            Case "1150": a(3) = nd.GetAttribute("СумОтч")
                            Case "1170": a(4) = nd.GetAttribute("СумОтч")
                            Case "1210": a(5) = nd.GetAttribute("СумОтч")
                            Case "1250": a(6) = nd.GetAttribute("СумОтч")
                            Case "1260": a(7) = nd.GetAttribute("СумОтч")
                        End Select
                    End If
                Next
            End If
        Next
    End With
    Cells(3, 1).Resize(1, UBound(a)) = a
End Sub

Sub uuu()
    Dim a()
    Dim i&
    Dim sd As Object
'----------------------
    a = Sheets(2).UsedRange.Value
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a)
        sd.Item(a(i, 1)) = a(i, 2)
    Next
    With Sheets(1)
        a = .UsedRange.Value
        For i = 2 To UBound(a)
            If sd.Exists(a(i, 1)) Then
                a(i, 4) = sd.Item(a(i, 1))
            End If
        Next
        .Cells(1, 1).Resize(UBound(a), UBound(a, 2)) = a
    End With
    Beep
    MsgBox "Готово!"
End Sub

s = Cells(9, 3)
For i = 1 To UBound(a)
    If a(i, 1) Like s Then
        MsgBox a(i, 2)
        Exit For
    End If
Next

Sub uuu()
    Dim a()
    Dim i&
'-----------
    a = Range("Table1").Value
    For i = 1 To UBound(a)
        If a(i, 1) Like Cells(9, 3) Then
            Beep
            MsgBox a(i, 1)
        End If
    Next
End Sub