Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как заставить макрос копирования из одной книги в другую, работать только с одним листом?
 
#1
02.06.2020 12:12:59
Доброго времени суток. Есть макрос который компирует все данные из одной книги и собирает их в список в другую.
Надо что бы брал только первый в качестве примера(для быстрого отчёта)
К сожалению своих знаний не хватает что бы исправить код.
Код
Dim ws As Worksheet
     
    Set wbReport = ActiveWorkbook

 Workbooks.Open ("1.xlsx")
      Set wbCurrent1 = ActiveWorkbook

    For Each ws In wbCurrent1.Worksheets
     
        'определяем номер последней строки на текущем листе и на листе сборки
        n = wbReport.Worksheets("Отчёт").Range("A1").CurrentRegion.Rows.Count
         
        'задаем исходный диапазон, который надо скопировать с каждого листа - любой вариант на выбор:
        
        Set rngData = ws.Range("A3", ws.Range("A3").SpecialCells(xlCellTypeLastCell))    'от А3 и до конца листа
         
        'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
        rngData.Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)
         
    Next ws
Заранее благодарен.
 
 
 
#2
02.06.2020 12:41:45
Kompas13, про какую формулу Вы говорите?
И код следует оформлять соответствующим тегом: ищите такую кнопку (см. скрин) и исправьте своё сообщение.
 
 
 
#3
02.06.2020 12:59:56
Я наверное некорректно выразился в заголовке. Я имел в виду макрос, а не формулу
 
 
 
#4
02.06.2020 13:11:30
Почему "наверное"? Очень даже конкретно.
Название поменял.
По вопросу: уберите цикл перебора листов.
 
 
 
#5
02.06.2020 13:58:53
Если убрать цикл вылезает окошко с ошибкой 91.
Изменено: Kompas13 - 02.06.2020 14:01:01
 
 
 
#6
02.06.2020 14:55:39
Код
  Dim CopyTo As Range
  With ThisWorkbook.Worksheets(1)
    Set CopyTo = .Cells(.UsedRange.SpecialCells(11).Offset(1).Row, 1)
  End With
  With Workbooks.Open("1.xlsx").Worksheets(1)
    .Range(.Range("A3"), .Range("A3").SpecialCells(11)).Copy CopyTo
  End With
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#7
02.06.2020 16:37:08
Огромное спасибо, Iгор Гончаренко, итоговый вариант:
Код
Dim ws As Worksheet
Dim CopyTo As Range 

 Workbooks.Open ("Отчёт.xlsm")    
    Set wbReport = ActiveWorkbook
 
 Workbooks.Open ("1.xlsx")
      Set wbCurrent1 = ActiveWorkbook

'определяем последнюю строчку на листе копирования,т.е. место куда копировать 
 With wbReport.Worksheets(1)
    Set CopyTo = .Cells(.UsedRange.SpecialCells(11).Offset(1).Row, 1)
  End With

'находим диапазон данных в книге-источнике и копируем их
  With wbCurrent1.Worksheets(1)
.Range(.Range("A3"), .Range("A3").SpecialCells(11)).Copy CopyTo
  End With
Изменено: Kompas13 - 02.06.2020 16:39:12
 
 
 
#8
02.06.2020 18:09:18
 а такой итоговый код не проканает?
Код
 Dim CopyTo As Range
  With Workbooks.Open ("Отчёт.xlsm") .Worksheets(1)
    Set CopyTo = .Cells(.UsedRange.SpecialCells(11).Offset(1).Row, 1)
  End With
  With Workbooks.Open("1.xlsx").Worksheets(1)
    .Range(.Range("A3"), .Range("A3").SpecialCells(11)).Copy CopyTo
  End With
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#9
05.06.2020 08:58:13
Проканает.  Даже удобнее и понятнее будет. Спасибо
 
 
 
Страницы: 1
Наверх