Имеется таблица, которая постоянно увеличивается шаблонными листами (Лист1,2,3, n) в этой же таблице имеется лист в котором куски этих данных собираются (лист 4) как итоговые. Пробовал все делать через функцию =двссыл вставляя только названия новых листов, но так как количество строк в каждом листе может отличатся - ничего не получается.
Также с товарищем пробовали писать макрос, но в итоге он копирует все данные со всех листов, а мне нужно, чтобы он копировал данные только тех листов, которые еще не вписаны в итоговую таблицу (лист4)
Пример прилагаю. Макрос запускаю дабл кликом.
Буду рад любому решению, а то уже пальцы стесал Ctrl+C Ctrl+V))
Добрый день, уважаемые умы програмиирования VBA.
Помогите решить задачку:
Имеется таблица, которая постоянно увеличивается шаблонными листами (Лист1,2,3, n) в этой же таблице имеется лист в котором куски этих данных собираются (лист 4) как итоговые. Пробовал все делать через функцию =двссыл вставляя только названия новых листов, но так как количество строк в каждом листе может отличатся - ничего не получается.
Также с товарищем пробовали писать макрос, но в итоге он копирует все данные со всех листов, а мне нужно, чтобы он копировал данные только тех листов, которые еще не вписаны в итоговую таблицу (лист4)
Пример прилагаю. Макрос запускаю дабл кликом.
Буду рад любому решению, а то уже пальцы стесал Ctrl+C Ctrl+V))Exceltseba
Ага, еще забыл добавить. Текущий макрос перебирает листы, которые находятся слева от итогового, а мне желательно, чтобы перебирались листы по всей книге. Можно ли этот вопрос решить через переназывание новых листов, например ЛистСтат1,ЛистСтат2,ЛистСтат3 и ЛистСтатn...
Заранее благодарен за внимание и оказанную помощь
Ага, еще забыл добавить. Текущий макрос перебирает листы, которые находятся слева от итогового, а мне желательно, чтобы перебирались листы по всей книге. Можно ли этот вопрос решить через переназывание новых листов, например ЛистСтат1,ЛистСтат2,ЛистСтат3 и ЛистСтатn...
Заранее благодарен за внимание и оказанную помощьExceltseba
Private Sub CopyData() Dim sh As Worksheet For Each sh In Worksheets If sh.Name <> "ИТОГ" Then If Right$(sh.Name, 1) <> "." Then sh.Name = sh.Name & "." sh.Range("A2:F" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Copy Worksheets("ИТОГ").Cells(Rows.Count, 1).End(xlUp).Offset(1) End If End If Next End Sub
[/vba] (в конце имени скопированного листа добавляется точка, чтоб следующий раз не обрабатывать его повторно)
Доброй ночи! Как вариант: [vba]
Код
Private Sub CopyData() Dim sh As Worksheet For Each sh In Worksheets If sh.Name <> "ИТОГ" Then If Right$(sh.Name, 1) <> "." Then sh.Name = sh.Name & "." sh.Range("A2:F" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Copy Worksheets("ИТОГ").Cells(Rows.Count, 1).End(xlUp).Offset(1) End If End If Next End Sub
[/vba] (в конце имени скопированного листа добавляется точка, чтоб следующий раз не обрабатывать его повторно)KSV
Только появилась другая проблемка - листы, которые макрос переназвал с помощью функции =двссыл передавали данные на другие листы, а теперь связи оборвались т.к. изменено имя ... полезли ошибки повсюду(((
Можно ли макрос настроить так, чтобы небыло переименования или мы возвращаемся к первоначальному вопросу? Или проще будет перепровести =двссыл.... только из по меньшей мере 100 шт...
Что посоветуете?
Огромнейшее спасибо!! Все сработало!!!
Только появилась другая проблемка - листы, которые макрос переназвал с помощью функции =двссыл передавали данные на другие листы, а теперь связи оборвались т.к. изменено имя ... полезли ошибки повсюду(((
Можно ли макрос настроить так, чтобы небыло переименования или мы возвращаемся к первоначальному вопросу? Или проще будет перепровести =двссыл.... только из по меньшей мере 100 шт...
Exceltseba, вот так попробуйте (поигралась с кодом Сергея ( KSV)) [vba]
Код
Private Sub CopyData() Dim sh As Worksheet Dim check For Each sh In Worksheets If sh.Name <> "ИТОГ" Then check = WorksheetFunction.CountIf(Columns("H:H"), sh.Name) If check = 0 And Left(sh.Name, 1) = "X" Then With Worksheets("ИТОГ") sh.Range("A2:F" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1) lr = .Cells(.Rows.Count, 1).End(xlUp).Row Worksheets("ИТОГ").Range("H" & lr - sh.Cells(Rows.Count, 1).End(xlUp).Row + 2 & ":H" & lr) = sh.Name End With End If End If Next End Sub
[/vba]
Exceltseba, вот так попробуйте (поигралась с кодом Сергея ( KSV)) [vba]
Код
Private Sub CopyData() Dim sh As Worksheet Dim check For Each sh In Worksheets If sh.Name <> "ИТОГ" Then check = WorksheetFunction.CountIf(Columns("H:H"), sh.Name) If check = 0 And Left(sh.Name, 1) = "X" Then With Worksheets("ИТОГ") sh.Range("A2:F" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1) lr = .Cells(.Rows.Count, 1).End(xlUp).Row Worksheets("ИТОГ").Range("H" & lr - sh.Cells(Rows.Count, 1).End(xlUp).Row + 2 & ":H" & lr) = sh.Name End With End If End If Next End Sub