Страницы: 1
RSS
копирование данных их одной книги в другую
 
Здравствуйте,Уважаемые Специалисты!

Искал по форуму но не нашёл. Возможно,это частый вопрос.
Если есть аналог - отправьте в топик нужный:)
Подскажите,пожалуйста.

Есть книга *например "образец.xls" с данными на разных листах
"Лист1","Лист2",Лист3"
И аналогичная книга РАБОЧАЯ.xls с листами
"Лист1","Лист2",Лист3"

Нужно данные из книги листов образец.xls (заполненные диапазоны) разнести на листы в книгу РАБОЧАЯ.xls
Если она НЕ открыта,то её нужно открыть. Немножко запутался в присвоении Wb и Wb2 для открытой и текущей книги.
По сути получается так:
1)Зашли в книгу Образец,зашли на "Лист1" скопировали диапазон
открыли книгу(если она открыта просто зашли) РАБОЧАЯ.xls зашли на "Лист1" - вставили данные.
2)Снова зашли в книгу Образец,на "Лист2" скопировали диапазон
зашли в книгу РАБОЧАЯ.xls на "Лист2" - вставили данные.
и так далее.
Надеюсь,что объяснил. Если создавать пример - то их будет два.

Спасибо большое за помощь.
 
Цитата
suvorovdim написал:
Нужно данные из книги листов образец.xls (заполненные диапазоны) разнести на листы в книгу РАБОЧАЯ.xls
Если она НЕ открыта,то её нужно открыть.
Отсюда делаю вывод, что макрос находится в книге образец.xls.
Код
Sub Suvorovdim()
Const WB_RAB = "c:\temp\РАБОЧАЯ.xls" 'путь к книге

Dim wbRab As Workbook, ws As Worksheet
  On Error Resume Next
  Set wbRab = Workbooks(Mid$(WB_RAB, InStrRev(WB_RAB, Chr$(92)) + 1))
  If Err Then
    Err.Clear
    Set wbRab = Workbooks.Open(WB_RAB)
    If Err Then
      MsgBox "Не удалось открыть книгу" & vbLf & vbLf & WB_RAB, vbCritical
      Exit Sub
    End If
  End If
  For Each ws In ThisWorkbook.Worksheets
    ws.UsedRange.Copy wbRab.Sheets(ws.Name).Range(ws.UsedRange.Address)
  Next
  If Err Then MsgBox "При копировании возникли ошибки", vbExclamation
End Sub
Изменено: Казанский - 11.03.2015 00:49:54
 
Спасибо Вам, Уважаемый Казанский!

Простите,что некорректно поставил условие...С каждого листа нужно взять несколько определённых диапазонов
и вставить их в книгу РАБОЧАЯ в теже листы в теже диапазоны только значениями.

Например..с книги образец "Лист1"-например, B1:C46;I50:M150 и так далее
в книгу РАБОЧАЯ "Лист 1" в диапазоны
B1:C46;I50:M150 и так далее

Ещё раз простите за неточность.
 
Эти "несколько определённых диапазонов" Вы задаете вручную или они как-то вычисляются?
Диапазоны одинаковые на всех листах или разные?
Если вручную, да еще разные, я бы предложил присвоить определенные имена копируемым диапазонам, чтобы в макросе ориентироваться по именам. Например, пусть имя диапазона начинается с "copy": copy1, copy_Заголовок и т.д.
Иначе при изменении диапазонов придется править код.
Цитата
suvorovdim написал: только значениями
А форматы переносить?

Наверно, пример все же пригодился бы.
Изменено: Казанский - 11.03.2015 14:54:24
 
Создайте на диске С папку Отложено.
Поместите туда файл образец.xls
Откройте файл рабочая.xls.
Активируйте кнопку OPEN.

В книгу рабочая.xls на Лист1 и Лист2 должны скопироваться данные(только значения!) из Листа1 и Листа2 книги образец.xls
Диапазоны копирования и вставки одинаковы.
После копирования файл образец.xls нужно закрыть.
Код можно вписать в имеющийся макрос open_me.


Небольшая корректировка. Название файла в папке"Отложено" может быть любое.


Спасибо большое за помощь!
Изменено: suvorovdim - 11.03.2015 21:28:29
 
Здравствуйте, Уважаемые Специалисты!
Поскольку топик уплыл на вторую страничку форума позволил себе напомнить о моём вопросе выше.
Помогите, пожалуйста.

С уважением,
Суворов
 
Макрос в книге Рабочая
Код
Sub open_me()
'здесь код макроса
Dim FD As FileDialog
Dim ObrazWb As Workbook
Dim ObrazWsh As Worksheet
Dim iFileName As String
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .Filters.Clear              'удаляет предопределенные фильтры
        .Filters.Add "Microsoft Excel files", "*.xls"
        .Filters.Add "All files", "*.*"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        .Title = "Открытие документа Образец с данными для копирования"
        .ButtonName = "Открыть"
        If .Show = False Then
            MsgBox "Вы не указали нужный файл!", 48, "Ошибка"
            Exit Sub
        Else
        iFileName = .SelectedItems(1)
        End If
    End With
    Set FD = Nothing
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
    Set ObrazWb = Workbooks.Open(Filename:=iFileName, UpdateLinks:=False, ReadOnly:=True)
    Set ObrazWsh = ObrazWb.Worksheets("Лист1")
    With ObrazWsh
        .Range("C9:E22").Copy
        ThisWorkbook.Worksheets("Лист1").Range("C9").PasteSpecial xlPasteValues
        .Range("J16:L29").Copy
        ThisWorkbook.Worksheets("Лист1").Range("J16").PasteSpecial xlPasteValues
    End With
     Set ObrazWsh = ObrazWb.Worksheets("Лист2")
    With ObrazWsh
        .Range("H17:J30").Copy
        ThisWorkbook.Worksheets("Лист2").Range("H17").PasteSpecial xlPasteValues
        .Range("M5:O18").Copy
        ThisWorkbook.Worksheets("Лист2").Range("M5").PasteSpecial xlPasteValues
    End With
    ObrazWb.Close SaveChanges:=False
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
MsgBox ("Сработал макрос OPEN_ME")
End Sub
Изменено: Kuzmich - 11.03.2015 23:16:46
 
Спасибо, Уважаемый Kuzmich!:)
Простите за комментарий.
Выскакивает диалоговое окно с выбором файла,которое уже есть и в моём коде.
В моём файле есть функция (GetFileName). И макрос choise_dir  файл образец.xls открывает.
Дальше в Вашем случае никаких копирований диапазонов не происходит..
Изменено: suvorovdim - 11.03.2015 23:54:10
 
Закройте файл Образец, а в файле Рабочий запустите макрос open_me
в диалоговом окне выберите файл Образец
 
suvorovdim Посмотрите немного переделанный Ваш вариант.
 
Спасибо! Да,всё работает. Виноват, сам не разобрался...

А где нужно изменить,чтобы использовать функцию в моём файле?
И где изменить,чтобы открывался нужный каталог для выбора файла?
Например,как у меня на диске С папка "Отложено".
Спасибо за ответы!

С уважением,
Суворов
 
Цитата
у меня на диске С папка "Отложено".
Если рабочий файл будет в этой папке, то диалог его и откроет
.InitialFileName = ThisWorkbook.Path
 
Это я понял, Kuzmich:) А как указать конкретную папку?
 
Цитата
А как указать конкретную папку?
А зачем тогда диалог выбора файла Образец?
 
В указанной папке может быть несколько файлов. Они там "откладываются" с других разОв:)
Уважаемый gling!
Посмотрел Ваш вариант. Спасибо! Разбираюсь:)
 
Уважаемый gling! Всё достигнуто,так и нужно!
Спасибо Казанский и Kuzmich!
Я тоже в копилочку Ваши советы заберу:)
Тема закрыта.

Если позволите Уважаемый gling...последний вопрос...
Если всё-таки нужно скопировать не только значения,но значения и форматы (заливку,выделенный шрифт) ячеек, которые есть в файле образец.xls.
Как изменить строчку в Вашем коде(выше)?
Код
Wb2.Sheets("Лист1").Range("A1:P100").Value = Wb.Sheets("Лист1").Range("A1:P100").Value

Спасибо за ответ.
Удачи всем!
Изменено: suvorovdim - 12.03.2015 03:00:11
 
Тогда нужно не присваивать, а копировать.
 
Тогда так
Код
Wb2.Sheets("Лист1").Range("A1:P100").Copy Wb.Sheets("Лист1").Range("A1:P100")
 
Спасибо, gling!
В моём случае лишь изменил порядок WB. Низкий поклон Вам и Юрию!:) Тема закрыта.
Код
   Wb.Sheets("Лист1").Range("A1:P100").Copy Wb2.Sheets("Лист1").Range("A1:P100")

Страницы: 1
Наверх