lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row

lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row

    Dim shislostrok&, lc&, rc As Range, rt As Range, x, xt As ListObject
    
    shislostrok = 11
    Set rt = Sheets("внедрение").Range("A1:C" & shislostrok)
    For Each x In Sheets("внедрение").ListObjects
        If Not Intersect(x.Range, rt) Is Nothing Then
            Set xt = x
            Exit For
        End If
    Next
    If xt Is Nothing Then
        Exit Sub
    End If
    rt.Copy
    With Sheets("Данные").Range("A" & shislostrok + 6).Resize(xt.ListRows.Count, xt.ListColumns.Count)
        .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        For lc = 1 To xt.ListColumns.Count
            .Replace xt.Name & "[" & xt.ListColumns(lc).Name & "]", xt.ListColumns(lc).DataBodyRange.Address, xlPart
        Next
    End With
    Sheets("внедрение").Application.CutCopyMode = False

Sub SplitSheets5()
     Dim s As Worksheet
     Application.DisplayAlerts = False
     For Each s In ActiveWorkbook.Worksheets
       If s.Index > 2 Then
         If s.Cells(33, 16).Value = CVErr(xlErrna) Then
            s.Delete
        else
            s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "\" &  s.Name & ".pdf", Type:=xlTypePDF
        end if
      end if
    Next
    Application.DisplayAlerts = True
End Sub

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    Dim wb As Workbook
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Set wb = Application.Workbooks.Open(sFolder & sFiles, False, Password:="123")
        wb.Password = ""
        wb.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub

vData = ExecuteExcel4Macro(sAddress)
If Not Iserror(vData) then
    range("A1").value = vData
end if

Set xlBook = xl.workbooks.Open(filepath)

Set xlBook = xl.workbooks(filepath)

Set xl = GetObject(,"Excel.Application")