Копирование данных из одного excel файла в другой - VBA

Узнай цену своей работы

Формулировка задачи:

Добрый день! Знаю тут много тем про копирование данных. Но я так и не нашла по теме. Вобщем мне надо из разных файлов собрть ин6формацию в один. Я сделала это так:
Листинг программы
  1. iPath = ActiveWorkbook.Path
  2. Workbooks.Open Filename:=iPath + "\Иркутская.xlsx"
  3. Workbooks("Иркутская.xlsx").Worksheets("Таблица1").Range("C331").Copy
  4. Workbooks("Общая.xlsm").Activate
  5. ActiveWorkbook.Worksheets("Лист1").Range("D3").Select
  6. ActiveSheet.Paste
  7. Workbooks("Иркутская.xlsx").Close
  8. iPath = ActiveWorkbook.Path
  9. Workbooks.Open Filename:=iPath + "\Иркутская.xlsx"
  10. Workbooks("Иркутская.xlsx").Worksheets("Таблица1").Range("C332").Copy
  11. Workbooks("Общая.xlsm").Activate
  12. ActiveWorkbook.Worksheets("Лист1").Range("E3").Select
  13. ActiveSheet.Paste
  14. Workbooks("Иркутская.xlsx").Close
  15. iPath = ActiveWorkbook.Path
  16. Workbooks.Open Filename:=iPath + "\Иркутская.xlsx"
  17. Workbooks("Иркутская.xlsx").Worksheets("Таблица1").Range("C333").Copy
  18. Workbooks("Общая.xlsm").Activate
  19. ActiveWorkbook.Worksheets("Лист1").Range("F3").Select
  20. ActiveSheet.Paste
  21. Workbooks("Иркутская.xlsx").Close
Вобщем каждый раз открываю и закрываю файл чтобы вытащить значение одной ячейки. Вот как сделать чтобы сразу вытаскивать эти все знаения и вставлять их в нужные ячейки. И вот интересно как сделать чтобы допустим из нужного файла по одному столбцу найти значение допустим а = 3407 и если нашлось то выбераем значение из столбца рядом напротив которого эта цифра и вставляем ее в общий файл в нужную ячейку. надеюсь понятно объяснила)

Решение задачи: «Копирование данных из одного excel файла в другой»

textual
Листинг программы
  1. Sub Кнопка2_Щелчок() ' Загрузка предварительной заявки
  2.    MainName = ActiveWorkbook.Name
  3.     If Cells(3, 3) <> Empty Then
  4.     MsgBox "Очистите поле"
  5.     Exit Sub
  6.     Else
  7. adres_svod_zayavka_rb = GetFilePath("Выберите файл Предварительной заявки", , "Документы Excel", "*.xlsx, *.xls") ' запрашиваем имя файла
  8.    If adres_svod_zayavka_rb = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла
  9.    Workbooks.Open Filename:=adres_svod_zayavka_rb
  10.     Filename = ActiveWorkbook.Name
  11.     Workbooks(Filename).Worksheets("Лист1").Range("A1:LA200").Copy
  12.     With Workbooks(MainName)
  13.         .Activate
  14.         .Worksheets("Заявка РБ").Range("С2:LC201").PasteSpecial Paste:=xlPasteValues
  15.     End With
  16.     Application.CutCopyMode = False
  17.     Workbooks(Filename).Close SaveChanges = False
  18.     Cells(2, 2).Select
  19.     End If
  20. End Sub
  21.  
  22. Function GetFilePath(Optional ByVal Title As String = "Выберите файл для загрузки", _
  23.                      Optional ByVal InitialPath As String = "c:\", _
  24.                      Optional ByVal FilterDescription As String = "Книги Excel", _
  25.                      Optional ByVal FilterExtention As String = "*.xls*") As String
  26.     ' функция выводит диалоговое окно выбора файла с заголовком Title,
  27.    ' начиная обзор диска с папки InitialPath
  28.    ' возвращает полный путь к выбранному файлу, или пустую строку в случае отказа от выбора
  29.    ' для фильтра можно указать описание и расширение выбираемых файлов
  30.    On Error Resume Next
  31.     With Application.FileDialog(msoFileDialogOpen)
  32.         .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
  33.         .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
  34.         If .Show <> -1 Then Exit Function
  35.         GetFilePath = .SelectedItems(1): PS = Application.PathSeparator
  36.     End With
  37. End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 4.133 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы