Sub Автофигура1_Щелкнуть()    ' "добавить" на листе "Заявки"
    Dim ws As Worksheet, wsLog As Worksheet, lr&, lrlog&, i&
    Dim rngContr As Range, cc As Range
    Dim tb As ListObject, lCols As Long, lCol As Long
    Dim lRows As Long, lRow As Long, lColStart As Long, lRowStart As Long
    Dim strOshibka As String, arrOsh()
    
    Set ws = ActiveSheet: Set wsLog = ThisWorkbook.Sheets("Заявки")
    On Error Resume Next
    Set tb = ws.ListObjects("Таблица3")
    lCols = tb.ListColumns.Count
    '    lCol = tb.ListColumns(lCols).Range.Column
    lRows = tb.ListRows.Count
    '    lRow = tb.ListRows(lRows).Range.Row
    '    lColStart = tb.ListColumns(1).Range.Column
    '    lRowStart = tb.ListRows(1).Range.Row - 1
    arrOsh = Array("Введите номер заявки", "Введите дату заявки", "Введите контрагента", "Введите ценовую группу")
    lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    With ws
        Set rngContr = Union(.[e1], .[c1], .[d3], .[d4])
        For Each cc In rngContr
            If cc = "" Then
                If strOshibka <> "" Then
                    strOshibka = strOshibka & Chr(10) & arrOsh(i)
                Else: strOshibka = arrOsh(i)
                End If
            End If
            i = i + 1
        Next cc
    End With

    If strOshibka <> "" Then MsgBox strOshibka, vbInformation, "Ошибка ввода данных": Exit Sub

    lrlog = wsLog.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

    wsLog.Cells(lrlog, 3).Resize(lRows, lCols).Value = tb.DataBodyRange.Value
    wsLog.Cells(lrlog, 1).Resize(lRows, 1).Value = ws.[e1].Value
    wsLog.Cells(lrlog, 2).Resize(lRows, 1).Value = ws.[c1].Value
    wsLog.Cells(lrlog, 3).Resize(lRows, 1).Value = ws.[d3].Value
End Sub