Всем добрый день. Сделал один файл для сбора данных из закрытого файла. Макрос найден и подправлен под себя на просторах интернета.Который вытягивает данные из закрытых файлов. Как бы все устраивает. Есть еще теперь проблема вытянуть/скопировать данные с этих листов (название может измениться в дальнейшем сейчас названия временные) в сводный лист из которого наверное все де паверкверти будут тянуться данные. Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно. Потому как данных может быть по 100 -200 и более строк. Он же вытягивает их не все заполненные строки да еще и кусок таблицы дорисовывает... Помогите дописать макрос что бы он : Вытягивал все данные с каждого листа поочередно Когда вытягивал снова, то дописывал новые данные а не заменял их. Данные вставлял начиная с 5 строки ( пожалуйста напишите коментарии в макросе, что бы я разобрался хоть немного) Что бы при добавлении еще каких либо листов, макрос не считывал с них данные, так как файл будет расти дальше. Спасибо.
Всем добрый день. Сделал один файл для сбора данных из закрытого файла. Макрос найден и подправлен под себя на просторах интернета.Который вытягивает данные из закрытых файлов. Как бы все устраивает. Есть еще теперь проблема вытянуть/скопировать данные с этих листов (название может измениться в дальнейшем сейчас названия временные) в сводный лист из которого наверное все де паверкверти будут тянуться данные. Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно. Потому как данных может быть по 100 -200 и более строк. Он же вытягивает их не все заполненные строки да еще и кусок таблицы дорисовывает... Помогите дописать макрос что бы он : Вытягивал все данные с каждого листа поочередно Когда вытягивал снова, то дописывал новые данные а не заменял их. Данные вставлял начиная с 5 строки ( пожалуйста напишите коментарии в макросе, что бы я разобрался хоть немного) Что бы при добавлении еще каких либо листов, макрос не считывал с них данные, так как файл будет расти дальше. Спасибо.Santtic
Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно
Потому что у вас есть скрытые листы в книге и макрос при цикле по листам переносит данные и из скрытых листов. На листе Zvit сделайте шапку, аналогичную остальным листам. [vba]
Код
Sub Sbor11() Dim Sht As Worksheet Dim iLastRow As Long Dim iLR As Long iLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Range("A10:K" & iLastRow).EntireRow.Clear '.Delete 'Clear For Each Sht In Worksheets If Sht.Name <> "Zvit" And Not Sht.Visible = xlSheetHidden Then With Sht iLR = .Cells(.Rows.Count, 5).End(xlUp).Row iLastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Cells(iLastRow, 1) End With End If Next End Sub
[/vba]
Цитата
Макрос который у меня есть, собирает данные вставляет в лист "Zvit" не корректно
Потому что у вас есть скрытые листы в книге и макрос при цикле по листам переносит данные и из скрытых листов. На листе Zvit сделайте шапку, аналогичную остальным листам. [vba]
Код
Sub Sbor11() Dim Sht As Worksheet Dim iLastRow As Long Dim iLR As Long iLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Range("A10:K" & iLastRow).EntireRow.Clear '.Delete 'Clear For Each Sht In Worksheets If Sht.Name <> "Zvit" And Not Sht.Visible = xlSheetHidden Then With Sht iLR = .Cells(.Rows.Count, 5).End(xlUp).Row iLastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Cells(iLastRow, 1) End With End If Next End Sub
Забыл о нем, он мне служит для формирования уникальных значений. Спасибо, макрос работает супер. Скажите пожалуйста, как прописать что бы макрос искал только на этих листах, т.е. в файл будут добавляться и не скрытые файлы. В нем будут вести учет, поэтому из этой таблицы сформируется минимум 15 таблиц. Каким образом это будет сделано,формулы, паверкверти, еще не знаем, но листы будут и не желательно чтобы с новых листов тянулась информация. Кажись решил "проблему" с помощью дописи кода [vba]
Код
If Sht.Name <> "Zvit" And Sht.Name = "ПВТР" Or Sht.Name = "Красноградський" Or Sht.Name = "Шебелинське" Or Sht.Name = "Стрійське" And Not Sht.Visible = xlSheetHidden Then
[/vba] Протестировал, при условии, что если не на всех листах есть информация, макрос выпадает в ошибку. Странно
Забыл о нем, он мне служит для формирования уникальных значений. Спасибо, макрос работает супер. Скажите пожалуйста, как прописать что бы макрос искал только на этих листах, т.е. в файл будут добавляться и не скрытые файлы. В нем будут вести учет, поэтому из этой таблицы сформируется минимум 15 таблиц. Каким образом это будет сделано,формулы, паверкверти, еще не знаем, но листы будут и не желательно чтобы с новых листов тянулась информация. Кажись решил "проблему" с помощью дописи кода [vba]
Код
If Sht.Name <> "Zvit" And Sht.Name = "ПВТР" Or Sht.Name = "Красноградський" Or Sht.Name = "Шебелинське" Or Sht.Name = "Стрійське" And Not Sht.Visible = xlSheetHidden Then
[/vba] Протестировал, при условии, что если не на всех листах есть информация, макрос выпадает в ошибку. СтранноSanttic
Сообщение отредактировал Santtic - Суббота, 14.03.2020, 11:45
For Each Sht In Worksheets If Sht.Visible Then Select Case Sht.Name Case "раз", "два", "три" With Sht iLR = .Cells(.Rows.Count, 5).End(xlUp).Row iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1) End With End Select End If Next
[/vba]
[vba]
Код
For Each Sht In Worksheets If Sht.Visible Then Select Case Sht.Name Case "раз", "два", "три" With Sht iLR = .Cells(.Rows.Count, 5).End(xlUp).Row iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1) End With End Select End If Next
Понял, сейчас и ваш опробую вариант. RAN, спасибо за помощь. Скажите пожалуйста, почему макрос выпает в ошибку. когда один из листов пуст. Он копирует только шапку этой таблицы а далее не идет по листам.
Понял, сейчас и ваш опробую вариант. RAN, спасибо за помощь. Скажите пожалуйста, почему макрос выпает в ошибку. когда один из листов пуст. Он копирует только шапку этой таблицы а далее не идет по листам.Santtic
почему макрос выпает в ошибку. когда один из листов пуст
Добавьте проверку в макрос [vba]
Код
With Sht iLR = .Cells(.Rows.Count, 5).End(xlUp).Row If iLR >= 5 Then iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1) End If End With
[/vba]
Цитата
почему макрос выпает в ошибку. когда один из листов пуст
Добавьте проверку в макрос [vba]
Код
With Sht iLR = .Cells(.Rows.Count, 5).End(xlUp).Row If iLR >= 5 Then iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1) End If End With
Супер, все заработало, всем благодарен за помощь. Теперь наша единственная женщина сможет легче собирать данные. Спасибо за помощь. Подскажите, а проверка это [vba]
Супер, все заработало, всем благодарен за помощь. Теперь наша единственная женщина сможет легче собирать данные. Спасибо за помощь. Подскажите, а проверка это [vba]
Sub Sbor12() Dim Sht As Worksheet Dim iLastRow As Long Dim iLR As Long Dim i As Long Dim ShtName iLastRow = Cells(Rows.Count, 2).End(xlUp).Row If iLastRow < 5 Then iLastRow = 5 Range("A5:Q" & iLastRow).EntireRow.Clear '.Delete 'Clear ShtName = Array("ПВТР", "Красноградський", "Шебелинське", "Стрійське") For i = LBound(ShtName) To UBound(ShtName) With Worksheets(ShtName(i)) If .Visible Then iLR = .Cells(.Rows.Count, 5).End(xlUp).Row If iLR >= 5 Then iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1) End If End If End With Next End Sub
[/vba]
Цитата
Не могу собрать ваш вариант
[vba]
Код
Sub Sbor12() Dim Sht As Worksheet Dim iLastRow As Long Dim iLR As Long Dim i As Long Dim ShtName iLastRow = Cells(Rows.Count, 2).End(xlUp).Row If iLastRow < 5 Then iLastRow = 5 Range("A5:Q" & iLastRow).EntireRow.Clear '.Delete 'Clear ShtName = Array("ПВТР", "Красноградський", "Шебелинське", "Стрійське") For i = LBound(ShtName) To UBound(ShtName) With Worksheets(ShtName(i)) If .Visible Then iLR = .Cells(.Rows.Count, 5).End(xlUp).Row If iLR >= 5 Then iLastRow = Sheets("Zvit").Cells(Sheets("Zvit").Rows.Count, 5).End(xlUp).Row + 1 '+ If iLastRow < 5 Then iLastRow = 5 .Range(.Cells(5, "a"), .Cells(iLR, "q")).Copy Sheets("Zvit").Cells(iLastRow, 1) End If End If End With Next End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Протестировал, при условии, что если не на всех листах есть информация, макрос выпадает в ошибку. Странно
