Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?
26.10.2020, 10:44:20

Войти
Добавляйтесь в нашу группу ВКонтакте - будьте в курсе всех новых событий сайта, узнавайте первым обо всех акциях и новых статьях!
31 492 Сообщений в 5 054 Тем от 10 407 Пользователей
Последний пользователь: adornmutual2
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Перенос данных из одной книги в другую.
Страниц: [1]   Вниз
Печать
Автор Тема: Перенос данных из одной книги в другую.  (Прочитано 14856 раз)
0 Пользователей и 1 Гость смотрят эту тему.
ZiLLi-BoBa
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 16


Просмотр профиля E-mail
« : 27.03.2012, 15:37:28 »

Доброго времени суток, уважаемые коллеги.

В виду того, что по-прежнему пытаюсь познать азы VBA столкнулся с проблемой  Плачущий
Не могу назначить кнопке правильный код, чтобы по её нажатию -> книга2 открывалась -> в выделенную ячейку книга1 копировался фиксированный диапазон данных -> книга2 закрывалась...
Думал назначить переменные, обозначив selection.row, но дальше чтобы я не писал эксель ругается, что неправильно задан объект  Плачущий
Уважаемые, если у кого есть подобный опыт, а скорее всего просто наличие большей сознательности чем пока у меня в этом вопросе, помогите пожалуйста Обеспокоенный

Спасибо всем за просмотр темы и отзывы.
Записан
nilem
Эксперты
Постоялец
*

Репутация: +39/-0
Офлайн Офлайн

Сообщений: 194


Просмотр профиля E-mail
« Ответ #1 : 27.03.2012, 16:36:30 »

Если диапазон, который нужно переносить, фиксированный и известно имя книги-источника, и оба файла лежат в одной папке, то можно так:
Код:
Option Explicit
Dim arr

Sub ClickAndMove()
Dim i As Long
[a1].Formula = "=ToArray('" & ThisWorkbook.Path & "\[Книга2.xlsx]Лист1'!F6:P6)"
Selection(1, 1).Resize(, 11).Value = arr
[a1] = ""
End Sub

Private Function ToArray(ref)
    arr = ref
End Function
Положите эту книгу (во вложении) в одну папку с Книга2.
Записан
ZiLLi-BoBa
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 16


Просмотр профиля E-mail
« Ответ #2 : 27.03.2012, 22:13:17 »

Большое спасибо Вам за отклик, но дело в том, что книги могут лежать только на своих местах (в разных папках на диске).
Именно поэтому при нажатии кнопки мне нужно определить как открыть нужную книгу(и путь к ней) и взять оттуда данные.
Я думал каким-то образом определить одну переменную как выделенную ячейку (много не нужно, то есть Integer), а другую как нужный диапазон в другой книге и уже этим оперировать, подставляя нужный диапазон в выделенную ячейку как значение. А именно в выделенную ячейку потому, что ячейка каждый раз предполагает быть следующей пустой по колонке "0", то есть каждый раз новая ячейка.

Вот как это сделать имея 2 переменные?
Буду признателен за любую наводку.

P.S.
Диапазон и имена книг фиксированные.
« Последнее редактирование: 27.03.2012, 22:16:43 от ZiLLi-BoBa » Записан
nilem
Эксперты
Постоялец
*

Репутация: +39/-0
Офлайн Офлайн

Сообщений: 194


Просмотр профиля E-mail
« Ответ #3 : 28.03.2012, 07:15:20 »

Например
Код:
Option Explicit
Dim arr

Sub ClickAndMove()
Dim i As Long, f As String
f = GetFilePath 'этот путь можно прописать куда-нибудь в ячейку

i = InStrRev(f, "\"): f = Mid(f, 1, i) & "[" & Mid(f, i + 1)
[a1].Formula = "=ToArray('" & f & "]Лист1'!F6:P6)"

'для Selection
Selection(1, 1).Resize(, 11).Value = arr

''или для последней незаполненной ячейки в столбце "О"
'Cells(Rows.Count, 15).End(xlUp).Offset(1).Resize(, 11).Value = arr

[a1] = ""
End Sub

Private Function ToArray(ref)
    arr = ref
End Function

Private Function GetFilePath(Optional ByVal Title As String = "Выбираем файл", Optional ByVal InitialPath As String) As String
GetFilePath = ""
With Application.FileDialog(msoFileDialogFilePicker)
    .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath: .Filters.Add "Excel", "*.xls*", 1
    If .Show = -1 Then If .SelectedItems(1) <> "" Then GetFilePath = .SelectedItems(1)
End With
End Function
Записан
ZiLLi-BoBa
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 16


Просмотр профиля E-mail
« Ответ #4 : 28.03.2012, 15:29:59 »

Уважаемый nilem, еще раз большое спасибо, что участвуете в решении мной данного вопроса, но к сожалению я только-только начал учится (самостоятельно) vba и по всей видимости не могу разобраться в таком коде самостоятельно  Плачущий
Не знаком с функцией "GetFilePath", прочитал её описание, но не могу понять как ей пользоваться.
Вы не могли бы ещё немного мне помочь? Обеспокоенный
Записан
nilem
Эксперты
Постоялец
*

Репутация: +39/-0
Офлайн Офлайн

Сообщений: 194


Просмотр профиля E-mail
« Ответ #5 : 28.03.2012, 20:34:56 »

Просто вставьте все это в стандартный модуль и назначьте на кнопку, как в прикрепленном файле. В Модуль2 еще варианты.
Записан
ZiLLi-BoBa
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 16


Просмотр профиля E-mail
« Ответ #6 : 30.03.2012, 07:32:25 »

Всё работает, спасибо большое! Но для меня очень сложно всё ещё, читаю книжки и пытаюсь вникнуть и научится пользоваться написанным Вами.

Пока не закрыли тему, скажите, уважаемые коллеги, есть ли возможность сократить код?
Если книга из которой переносятся данные всегда на одном и том же месте, один и тот же лист в ней и диапазон строк один и тот же. Ну и книга в которую всё переносится, меняется только строка, но мануально (в коде не указывается), то есть просто вставить известный диапазон.
Как написать код: выделенная ячейка в книге1 -> открыть известную книгу2 для копирования диапазона -> копировать диапазон -> вставить в выделенную ячейку в первой книге -> закрыть книгу2 Непонимающий

Спасибо всем!!!

Записан
ZiLLi-BoBa
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 16


Просмотр профиля E-mail
« Ответ #7 : 30.03.2012, 16:49:09 »

Разобрался, теперь могу это применять!
Ещё раз спасибо, nilem!  :D
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru