Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирую с листов в один - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирую с листов в один (Макросы/Sub)
Копирую с листов в один
Yar4i Дата: Понедельник, 23.12.2019, 15:22 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Добрый день дамы и господа :D

Пытаюсь адаптировать код под свои нужды
А именно скопировать содержимое от 4ой строки до строки, содержащей "Итого по ресурсному расчету:" в третьем столбце в новую книгу (хотя можно и в существующую - только вкладок мб много)....

[vba]
Код
Sub ИзЛистовВОдин()
    Dim ws As Worksheet
    Set wbCurrent = ActiveWorkbook
    Workbooks.Add
    Set wbReport = ActiveWorkbook
    'копируем на итоговый лист шапку таблицы из первого листа
    wbCurrent.Worksheets(1).Range("A4:G4").Copy Destination:=wbReport.Worksheets(1).Range("A1")
     
    'проходим в цикле по всем листам исходного файла
    For Each ws In wbCurrent.Worksheets
     
        'определяем номер последней строки на текущем листе и на листе сборки
'        N = wbReport.Worksheets(1).Range("С1:С").CurrentRegion.Rows.Count
        ' до слов Итого по ресурсному расчету:
               
'
'        For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
'If Cells(i, 3) = "Итого по ресурсному расчету:" Then
''   Cells(i, 3).Select
''        Selection.Copy
''        Range("T4").Select
''        ActiveSheet.Paste
'        End If
'Next
         
        'задаем исходный диапазон, который надо скопировать с каждого листа - любой вариант на выбор:
'        Set rngData = ws.Range("A1:D5")            'фиксированный диапазон или
'        Set rngData = ws.UsedRange                 'всё, что есть на листе или
'        Set rngData = ws.Range("F5").CurrentRegion    'область, начиная от ячейки F5 или
        Set rngData = ws.Range("A4", ws.Range("A4").SpecialCells(xlCellTypeLastCell))    'от А2 и до конца листа
         
        'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
        rngData.Copy Destination:=wbReport.Worksheets(1).Cells(N + 1, 1)
         
    Next ws
End Sub  
[/vba]

Что характерно - столбец 3 содержит последнюю строку с текстом "Итого по ресурсному расчету:"
Именно ее я пытался найти чтобы задать диапазон от 4ой строки и до строки содержащей "Итого по ресурсному расчету:" в третьем столбце (повторюсь).

код работал, пока я не начал вставлять наработки минулых лет. В таком виде он копирует лишь последний лист в новую книгу.
К сообщению приложен файл: 231219.xlsx (28.8 Kb)
 
Ответить
СообщениеДобрый день дамы и господа :D

Пытаюсь адаптировать код под свои нужды
А именно скопировать содержимое от 4ой строки до строки, содержащей "Итого по ресурсному расчету:" в третьем столбце в новую книгу (хотя можно и в существующую - только вкладок мб много)....

[vba]
Код
Sub ИзЛистовВОдин()
    Dim ws As Worksheet
    Set wbCurrent = ActiveWorkbook
    Workbooks.Add
    Set wbReport = ActiveWorkbook
    'копируем на итоговый лист шапку таблицы из первого листа
    wbCurrent.Worksheets(1).Range("A4:G4").Copy Destination:=wbReport.Worksheets(1).Range("A1")
     
    'проходим в цикле по всем листам исходного файла
    For Each ws In wbCurrent.Worksheets
     
        'определяем номер последней строки на текущем листе и на листе сборки
'        N = wbReport.Worksheets(1).Range("С1:С").CurrentRegion.Rows.Count
        ' до слов Итого по ресурсному расчету:
               
'
'        For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
'If Cells(i, 3) = "Итого по ресурсному расчету:" Then
''   Cells(i, 3).Select
''        Selection.Copy
''        Range("T4").Select
''        ActiveSheet.Paste
'        End If
'Next
         
        'задаем исходный диапазон, который надо скопировать с каждого листа - любой вариант на выбор:
'        Set rngData = ws.Range("A1:D5")            'фиксированный диапазон или
'        Set rngData = ws.UsedRange                 'всё, что есть на листе или
'        Set rngData = ws.Range("F5").CurrentRegion    'область, начиная от ячейки F5 или
        Set rngData = ws.Range("A4", ws.Range("A4").SpecialCells(xlCellTypeLastCell))    'от А2 и до конца листа
         
        'копируем исходный диапазон и вставляем в итоговую книгу со следующей строки
        rngData.Copy Destination:=wbReport.Worksheets(1).Cells(N + 1, 1)
         
    Next ws
End Sub  
[/vba]

Что характерно - столбец 3 содержит последнюю строку с текстом "Итого по ресурсному расчету:"
Именно ее я пытался найти чтобы задать диапазон от 4ой строки и до строки содержащей "Итого по ресурсному расчету:" в третьем столбце (повторюсь).

код работал, пока я не начал вставлять наработки минулых лет. В таком виде он копирует лишь последний лист в новую книгу.

Автор - Yar4i
Дата добавления - 23.12.2019 в 15:22
Kuzmich Дата: Понедельник, 23.12.2019, 15:54 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Макрос в стандартный модуль, запускать при активном листе "Нужно так"
[vba]
Код
Sub Sbor()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim FoundItogo As Range
  Cells.Clear
  For Each Sht In Worksheets
    If Sht.Name <> "Нужно так" Then        ' кроме листа "Нужно так"
      With Sht
        iLastRow = Cells(Rows.Count, 3).End(xlUp).Row + 2
        Set FoundItogo = .Columns(3).Find("Итого по ресурсному расчету:", , xlValues, xlWhole)
         .Range("A4:G" & FoundItogo.Row).Copy Cells(iLastRow, 1)
      End With
    End If
  Next
End Sub
[/vba]
 
Ответить
СообщениеМакрос в стандартный модуль, запускать при активном листе "Нужно так"
[vba]
Код
Sub Sbor()
Dim Sht As Worksheet
Dim iLastRow As Long
Dim FoundItogo As Range
  Cells.Clear
  For Each Sht In Worksheets
    If Sht.Name <> "Нужно так" Then        ' кроме листа "Нужно так"
      With Sht
        iLastRow = Cells(Rows.Count, 3).End(xlUp).Row + 2
        Set FoundItogo = .Columns(3).Find("Итого по ресурсному расчету:", , xlValues, xlWhole)
         .Range("A4:G" & FoundItogo.Row).Copy Cells(iLastRow, 1)
      End With
    End If
  Next
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 23.12.2019 в 15:54
Yar4i Дата: Понедельник, 23.12.2019, 16:18 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Макрос

Спасибо, работает, но когда клонирую второй лист и запускаю с "Нужно так", то код ругается на 91 ый символ в строке (т.е. уже с 3х листов приходится коду копировать)
[vba]
Код
.Range("A4:G" & FoundItogo.Row).Copy Cells(iLastRow, 1)
[/vba]


Сообщение отредактировал Yar4i - Понедельник, 23.12.2019, 16:19
 
Ответить
Сообщение
Макрос

Спасибо, работает, но когда клонирую второй лист и запускаю с "Нужно так", то код ругается на 91 ый символ в строке (т.е. уже с 3х листов приходится коду копировать)
[vba]
Код
.Range("A4:G" & FoundItogo.Row).Copy Cells(iLastRow, 1)
[/vba]

Автор - Yar4i
Дата добавления - 23.12.2019 в 16:18
Kuzmich Дата: Понедельник, 23.12.2019, 16:24 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
код ругается на 91 ый символ в строке

Что за символ?
Точно ли есть строка "Итого по ресурсному расчету:" в столбце С каждого листа?
 
Ответить
Сообщение
Цитата
код ругается на 91 ый символ в строке

Что за символ?
Точно ли есть строка "Итого по ресурсному расчету:" в столбце С каждого листа?

Автор - Kuzmich
Дата добавления - 23.12.2019 в 16:24
Yar4i Дата: Понедельник, 23.12.2019, 16:48 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
есть строка

Спасибо все работает. Не знаю причину, но несколько раз в одном и тот же файле (своем с 20 листами) запускал код... сначала ошибка вылазила 91 , а потом попробовал на 3 листах и все хорошо запустилось.

Спасибо.

Итого по ресурсному расчету - везде точно есть - это шаблон сметной программы.
К сообщению приложен файл: 2918119.jpg (22.3 Kb)
 
Ответить
Сообщение
есть строка

Спасибо все работает. Не знаю причину, но несколько раз в одном и тот же файле (своем с 20 листами) запускал код... сначала ошибка вылазила 91 , а потом попробовал на 3 листах и все хорошо запустилось.

Спасибо.

Итого по ресурсному расчету - везде точно есть - это шаблон сметной программы.

Автор - Yar4i
Дата добавления - 23.12.2019 в 16:48
Kuzmich Дата: Понедельник, 23.12.2019, 16:54 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Добавьте в код проверку: есть ли такая строка на листе
[vba]
Код
        Set FoundItogo = .Columns(3).Find("Итого по ресурсному расчету:", , xlValues, xlWhole)
        If Not FoundItogo Is Nothing Then
         .Range("A4:G" & FoundItogo.Row).Copy Cells(iLastRow, 1)
        Else
          MsgBox "Не найдена строка 'Итого по ресурсному расчету:' на листе " & Sht.Name
        End If
[/vba]
 
Ответить
СообщениеДобавьте в код проверку: есть ли такая строка на листе
[vba]
Код
        Set FoundItogo = .Columns(3).Find("Итого по ресурсному расчету:", , xlValues, xlWhole)
        If Not FoundItogo Is Nothing Then
         .Range("A4:G" & FoundItogo.Row).Copy Cells(iLastRow, 1)
        Else
          MsgBox "Не найдена строка 'Итого по ресурсному расчету:' на листе " & Sht.Name
        End If
[/vba]

Автор - Kuzmich
Дата добавления - 23.12.2019 в 16:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирую с листов в один (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!