[URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63  64  65  66  67  68      Sub   vstavka()             Dim   SourceWorkbook   As   Workbook          Dim   SourceWorksheet   As   Worksheet          Dim   DestinationWorksheet   As   Worksheet          Dim   FileDialog   As   FileDialog          Dim   SelectedFile   As   String          Dim   tbl   As   ListObject          Dim   newRow   As   ListRow          Dim   iLastRow   As   Long                  Set   tbl = ActiveSheet.ListObjects(  "Table1"  )          ' Добавить новую строку в таблицу          Set   newRow = tbl.ListRows.Add          With   Application              .ScreenUpdating =   False              .EnableEvents =   False              End   With                   ' Открываем диалоговое окно для выбора файла          Set   FileDialog = Application.FileDialog(msoFileDialogFilePicker)          With   FileDialog              .AllowMultiSelect =   False              .Title =   "Выберите файл для копирования данных"              .Filters.Clear              .Filters.Add   "Excel файлы"  ,   "*.xlsx; *.xlsm; *.xls"              If   .Show =   True   Then                  SelectedFile = .SelectedItems(1)              Else                  Exit   Sub              End   If          End   With          ' Открываем выбранный файл          Set   SourceWorkbook = Workbooks.Open(SelectedFile,   ReadOnly  :=  True  )          ' Указываем листы для копирования и вставки данных          Set   SourceWorksheet = SourceWorkbook.Sheets(  "TDSheet"  )          ' Копируем данные из выбранной книги в текущую книгу          Dim   arr   As   Variant          ReDim   arr(1   To   1, 1   To   11)          With   SourceWorksheet              arr(1, 1) = .Range(  "A9"  ).Value              arr(1, 2) = .Range(  "B17"  ).Value              arr(1, 3) = .Range(  "N17"  ).Value              arr(1, 4) = .Range(  "Z17"  ).Value              arr(1, 5) = .Range(  "C23"  ).Value              arr(1, 6) = .Range(  "B85"  ).Value              arr(1, 7) = .Range(  "V85"  ).Value              arr(1, 8) = .Range(  "B86"  ).Value              arr(1, 9) = .Range(  "J94"  ).Value              arr(1, 10) = .Range(  "P129"  ).Value              arr(1, 11) = .Range(  "G129"  ).Value          End   With                   With   newRow.Range.Cells(1).Resize(UBound(arr, 1), UBound(arr, 2))              .Value = arr              .Font.Bold =   False          End   With                      With   Application              .ScreenUpdating =   True              .EnableEvents =   True              .Calculation = ac              End   With                                   ' Закрываем и сохраняем выбранную книгу          SourceWorkbook.Close SaveChanges:=  False    End   Sub