Excel VBA Макросы Копирование данных из изменяющего свой размер диапазона в другую таблицу.

Автор Rengame113, 02 августа 2018, 10:48

Rengame113

Как можно скопировать меняющийся диапазон (открыл лист например 10 строк 20 столбцов, в другом 20 строк 17 столбцов и.д.)
На листе 1 выделяем ячейку В4 (ее значение будет заноситься в переменную) дальше сдвигаемся вправло на 2 ячейки в D4 и  выделяем всю строку до столбца n. Копируем ее. Переключаемся на лист 2 и вставляем скопированную строку в D4. Возвращаемся обратно на Лист 1 и переводим активную ячейку на B5.
Пытался реализовать  с помощью относительных ссылок, но когда дело дошло до выделения диапазона встал в ступор.
Прикладываю пример файла. В макросе копирую из книги в книге, но  в данном случае думаю не критично т.к. принцип действий яполагаю схож.

Спойлер
Sub Работа_с_файлами()
   
    Dim Wb_general As Workbook, Wb_MO As Workbook
    Dim sht_general As Worksheet, sht_MO As Worksheet
    Dim Проверка As String
    Dim Код_МО As String
    Dim Имя_файла_МО As String
    Dim Дата As String
    Dim Пароль As String
   
    Dim rngStart As Range
    Dim rngAll As Range     'весь рабочий диапазон
    Dim Nrow As Long        'число строк
    Dim Ncol As Long        'число столбцов
    Dim rngX As Range       'переменный диапазон
   
   
   
    Set Wb_general = Workbooks(Имя_файла)       ' Присвоение открытой главной книги
    Проверка = Cells(4, 102)        'внесение в переменную значение версии формы
    Дата = Cells(5, 5)      'Дата из ячейки E5
   
    Set Wb_MO = Workbooks.Open("C:\Users\1234\1.xls")        ' открытие файла МО
    Set sht_general = Wb_general.Sheets(1)      ' Имя рабочего листа главного
    Set sht_MO = Wb_MO.Sheets(1)        ' Имя рабочего листа МО
    Set sht_MO = ActiveSheet
    Код_МО = Cells(4, 2)    ' Код МО
   
    sht_MO.Unprotect Password:=Пароль        'Снимаем пароль с листа. пароль берем из ячейки А1
    Set rngStart = sht_MO.Range("B4")        ' ссылка на начальную ячейку
   
    Set rngAll = rngStart.CurrentRegion     ' определение рабочего диапозона
    Nrow = rngAll.Rows.Count        'число строк
    Ncol = rngAll.Columns.Count     'число столбцов
    Set rngX = rngAll.Cells(4, Ncol)        ' пытался так выделить  переменный диапазон с 4 ячейки до конца таблицы
    'Set rngX = rngStart.Offset(Nrow, -1)        ' переменный диапазон
   
    '-------------Проверка и удалить------------
    ActiveCell.Offset(0, 2).Cells(4, Ncol).Select  ' и так
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
   
End Sub
[свернуть]

[вложение удалено администратором]

Администратор

Я 'CurrentRegion' не использую, т.к. обычно файлы не имеют чёткой структуры, а 'CurrentRegion' работает до первой полностью пустой строки, столбца.
Я ищу последнюю строку, столбец.

Макрос
Sub Макрос()
   
    Dim sh_src As Worksheet, sh_res As Worksheet
    Dim lr As Long, lc As Long
   
    ' Присваиваем листам имена, чтобы потом обращаться в коде к листам по этим именам.
    Set sh_src = Worksheets("Лист1")
    Set sh_res = Worksheets("Лист2")
   
    ' Запись в переменные последней строки и столбца.
        ' End не работает со скрытыми строками, столбцами.
    lr = sh_src.Cells(sh_src.Rows.Count, "A").End(xlUp).Row
    lc = sh_src.Cells(2, sh_src.Columns.Count).End(xlToLeft).Column
   
    ' Копирование данных из одного листа на другой.
        ' Не должно быть скрытых строк с помощью автофильтра и расш. фильтра.
    sh_res.Range(sh_res.Range("D4"), sh_res.Cells(lr, lc)).Value = _
        sh_src.Range(sh_src.Range("D4"), sh_src.Cells(lr, lc)).Value

End Sub
[свернуть]