Макрос переноса данных из одного файла в другой

Автор Alexandrin, 28.01.2011, 12:12

« назад - далее »

Alexandrin

Добрый день всем! Нужна помощь.
Требуется, чтобы при нажатии кнопки в файле "Исходные данные", который может находиться в любом месте, выделенные желтым данные вставлялись в пустую строку, следующую после последней заполненной строки. Файл "Итоговый файл" находится в строго определенном месте, таблица в нем дополняется из файлов, аналогичных указанному выше. Место, откуда нужно вставить данные, указано в ячейках формулами. Ссылки скорее всего работать не будут, но можно сориентироваться по номерам ячеек.

Alex_ST

Посмотрите у Сержа (который 007) на форуме. Он, вроде, в друзьях с этим форумом, поэтому, надеюсь, что ссылка не будет считаться нарушением правил.
Там в топике Макрос "Copy_ROWs_to_EXT_FILE" я выкладывал решение - макрос, который копирует строки выбранных ячеек во внешний файл Excel.
С уважением, Алексей

Alexandrin


oljachak

Цитата: Alex_ST от 28.01.2011, 16:01
Посмотрите у Сержа (который 007) на форуме. Он, вроде, в друзьях с этим форумом, поэтому, надеюсь, что ссылка не будет считаться нарушением правил.
Там в топике Макрос "Copy_ROWs_to_EXT_FILE" я выкладывал решение - макрос, который копирует строки выбранных ячеек во внешний файл Excel.


А возможно сделать что бы бралось из 2 файлов источников?

Alex_ST

Вы, кажется, чего-то не совсем поняли...
Макрос Copy_ROWs_to_EXT_FILE заносится в стандартный модуль файла-источника.
Вот, я немного добавил комментариев в код для его понимабельности:
Sub Copy_ROWs_to_EXT_FILE()   ' скопировать строки выделенных ячеек во внешний файл-накопитель
    '---------------------------------------------------------------------------------------
    ' Procedure    : Copy_ROWs_to_EXT_FILE
    ' Author       : KuklP & Alex_ST
    ' Topic_HEADER : Макрос "Copy_ROWs_to_EXT_FILE"
    ' Topic_URL    : http://www.excelworld.ru/forum/3-176-2008-16-1293625247
    ' DateTime     : 29.12.10, 15:20
    ' Purpose      : скопировать строки выделенных ячеек во внешний файл-накопитель
    ' Notes        : после работы макроса файл-накопитель становится невидимым в обычных окнах Excel (как надстройка или Personal.xls)
    '---------------------------------------------------------------------------------------
        If Not TypeName(Selection) = "Range" Then Exit Sub
        Dim lr&, wb As Workbook, lb As Workbook
        With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
        Set wb = GetObject("c:\test.xls")   ' здесь нужно прописать полный путь к файлу-накопителю
        Set lb = ThisWorkbook
        lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row ' lr - номер последней не пустой строки файла-накопителя
        Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) ' вставить выбранные в файле-источнике строки после последней не пустой строки в файл-накопитель
        wb.Close (True)   ' закрыть файл-накопитель с сохранением
        With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
        Set wb = Nothing: Set lb = Nothing
End Sub

В файле-накопителе всего лишь в модуле книги прописывается обработка события Private Sub Workbook_Open()
        If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True
End Sub

При этом число файлов-источников ничем не ограничено. Можно и два, и три, и четыре...
С уважением, Алексей

Serge 007

Цитата: Alex_ST от 28.01.2011, 16:01
...надеюсь, что ссылка не будет считаться нарушением правил.
Нет, Алекс, не будет ;)
Если ссылка по теме - то на любом нормальном форуме это не будет нарушением правил.
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

Alex_ST

Цитата: Serge 007 от 28.01.2011, 22:44
Если ссылка по теме - то на любом нормальном форуме это не будет нарушением правил.
Ну, про все форумы это ты зря...
Например, на форуме про iPod'ы на iworld-club на меня модератор гневаться изволил, когда я там в конце ответа на вопрос одного из новичков посоветовал поподробнее посмотреть топик на форуме ipoding
При этом ни один из этих форумов я бы не отнёс к ненормальным. Оба очень толковые.
С уважением, Алексей

Serge 007

Цитата: Alex_ST от 29.01.2011, 23:27
...ни один из этих форумов я бы не отнёс к ненормальным. Оба очень толковые.
Толковый и нормальный - это разные понятия.
В рунете есть сайт киберфорум (я там тоже модератор). Очень толковый. Уровень постоянных участников минимум не ниже планетарного. Но ненормальный. Ссылки на другие форумы запрещены ВООБЩЕ. Почему - не знаю. Таково желание админа. Приходится ему подчиняться.
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

oljachak

Цитата: Alex_ST от 28.01.2011, 20:51
Вы, кажется, чего-то не совсем поняли...
Макрос Copy_ROWs_to_EXT_FILE заносится в стандартный модуль файла-источника.
Вот, я немного добавил комментариев в код для его понимабельности:
Sub Copy_ROWs_to_EXT_FILE()   ' скопировать строки выделенных ячеек во внешний файл-накопитель
    '---------------------------------------------------------------------------------------
    ' Procedure    : Copy_ROWs_to_EXT_FILE
    ' Author       : KuklP & Alex_ST
    ' Topic_HEADER : Макрос "Copy_ROWs_to_EXT_FILE"
    ' Topic_URL    : http://www.excelworld.ru/forum/3-176-2008-16-1293625247
    ' DateTime     : 29.12.10, 15:20
    ' Purpose      : скопировать строки выделенных ячеек во внешний файл-накопитель
    ' Notes        : после работы макроса файл-накопитель становится невидимым в обычных окнах Excel (как надстройка или Personal.xls)
    '---------------------------------------------------------------------------------------
        If Not TypeName(Selection) = "Range" Then Exit Sub
        Dim lr&, wb As Workbook, lb As Workbook
        With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
        Set wb = GetObject("c:\test.xls")   ' здесь нужно прописать полный путь к файлу-накопителю
        Set lb = ThisWorkbook
        lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row ' lr - номер последней не пустой строки файла-накопителя
        Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) ' вставить выбранные в файле-источнике строки после последней не пустой строки в файл-накопитель
        wb.Close (True)   ' закрыть файл-накопитель с сохранением
        With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
        Set wb = Nothing: Set lb = Nothing
End Sub

В файле-накопителе всего лишь в модуле книги прописывается обработка события Private Sub Workbook_Open()
        If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True
End Sub

При этом число файлов-источников ничем не ограничено. Можно и два, и три, и четыре...

Да, верно, извините. Просто ищу решение для копирования строк(но не все даннуе) из одного файла во второй и из третьего файла также во второй. Плюс еще есть свой сложности там. Уже цепляюсь за что то похожее.
https://forum.msexcel.ru/empty-t4785.0.html

Alexandrin

Про строки понятно, но мне нужно вставлять не строки целиком, а конкретные ячейки в нужное место, как я указал в файле. Как Это сделать?

Alexandrin

И как сделать, чтобы итоговый файл был виден?

Alex_ST

#11
Я же писАл, что в файле-накопителе в модуле книги необходимо прописать обработку события Private Sub Workbook_Open()
       If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True
End Sub

тогда накопитель не будет становиться не невидимым при обычном его открытии.

Я в своём примере продемонстрировал общий принцип копирования данных (строки) во внешний файл в строку, следующую за последней занятой.
Кто вам мешает теперь чуть-чуть "подпилить" макрос под свои нужды чтобы копировалась не вся строка, а только отдельные её ячейки?
С уважением, Алексей

Alexandrin

Цитата: Alex_ST от 30.01.2011, 22:04
Я же писАл, что файле-накопителе в модуле книги прописывается обработка события Private Sub Workbook_Open()
        If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True
End Sub

тогда накопитель не будет становиться не невидимым при обычном его открытии.

Я в своём примере продемонстрировал общий принцип копирования данных (строки) во внешний файл в строку, следующую за последней занятой.
Кто вам мешает теперь чуть-чуть "подпилить" макрос под свои нужды чтобы копировалась не вся строка, а только отдельные её ячейки?
С видимостью разобрался, спасибо  :) . Я просто не знаю, как в этом макросе прописать пути копирования нужных ячеек. Поэтому надеюсь на помощи форума  :)

Alex_ST

#13
Наверное, что-то типа этого:
Sub Copy_CELLS_to_EXT_FILE()   ' скопировать ячейки 1, 2, 3 из выбранной строки в ячейки 3, 2, 1 внешнего файла-накопителя
   If Not TypeName(Selection) = "Range" Then Exit Sub
   Dim DST_lr&, SRC_row& ' последняя занятая строка накопителя и строка источника, в которой выбрана любая ячейка
   Dim SRC_wbk As Workbook, DST_wbk As Workbook ' книги источника и накопителя
   With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
   Set DST_wbk = GetObject("c:\test.xls")   ' здесь нужно прописать полный путь к файлу-накопителю
   Set SRC_wbk = ThisWorkbook
   DST_lr = DST_wbk.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row    ' DST_lr - номер последней не пустой строки файла-накопителя
   SRC_row = Selection.Row
   SRC_wbk.ActiveSheet.Cells(SRC_row, 1).Copy DST_wbk.Sheets(1).Cells(DST_lr + 1, 3)    ' данные из ячейки 1 источника вставить в ячейку 3 первой пустой строки накопителя
   SRC_wbk.ActiveSheet.Cells(SRC_row, 2).Copy DST_wbk.Sheets(1).Cells(DST_lr + 1, 2)    ' данные из ячейки 2 источника вставить в ячейку 2 первой пустой строки накопителя
   SRC_wbk.ActiveSheet.Cells(SRC_row, 3).Copy DST_wbk.Sheets(1).Cells(DST_lr + 1, 1)    ' данные из ячейки 3 источника вставить в ячейку 1 первой пустой строки накопителя
   DST_wbk.Close (True)   ' закрыть файл-накопитель с сохранением
   With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
   Set DST_wbk = Nothing: Set SRC_wbk = Nothing
End Sub

Честно предупреждаю: не проверял, т.к. приболел, гриппую, жена от компа гонит соблюдать постельный режим 
С уважением, Алексей

Alexandrin

Желаю скорейшего выздоровления, а то у меня появился еще вопросик  :)
Как модернизировать макрос, чтобы он автоматически делал гиперссылку в ячейке 3 итогового файла на исходный файл?

Спасибо за помощь  :)