Добрый день. Нужен помощь в написании макроса. Будет книга с множеством листов, на листах будут таблицы, значения в которых будут браться из другой таблицы. Макрос будет проверять значения в ячейках столбца «С» и если оно нулевое, то скрывать данные строки. Макрос в написании которого мне нужна помощь должен копировать таблицы без учета скрытых строк с листов «1.1 , 1.2 , 1.3 , 1.4 , 2.1 , 2.2» с сохранением условного форматировании и по возможности с сохранением ширины строк и столбцов на лист2. Таблица с листа 1.1 должна копироваться на лист2 в ячейку «В2», с листа 1.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 1.1 со смещением в одну строку и т.д. Таблица с листа 2.1 должна копироваться на лист2 в ячейку «F2», с листа 2.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 2.1 со смещением в одну строку и т.д. Так как в таблице на листе 1.4 все значения равны 0, то она копироваться не должна. Значения равные 0 могут быть в любой таблице, нужна проверка, что заполнена ячейка «С6». Также прошу помощи в проверке макроса, который я нашел и переделал немного под себя. Он работает нормально, если только имеется значение в первом столбце. Пример прилагаю. Можете ли вы помочь с написанием макроса? Спасибо.
Добрый день. Нужен помощь в написании макроса. Будет книга с множеством листов, на листах будут таблицы, значения в которых будут браться из другой таблицы. Макрос будет проверять значения в ячейках столбца «С» и если оно нулевое, то скрывать данные строки. Макрос в написании которого мне нужна помощь должен копировать таблицы без учета скрытых строк с листов «1.1 , 1.2 , 1.3 , 1.4 , 2.1 , 2.2» с сохранением условного форматировании и по возможности с сохранением ширины строк и столбцов на лист2. Таблица с листа 1.1 должна копироваться на лист2 в ячейку «В2», с листа 1.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 1.1 со смещением в одну строку и т.д. Таблица с листа 2.1 должна копироваться на лист2 в ячейку «F2», с листа 2.2 проверить последнюю заполненную строку и скопироваться под таблицу с листа 2.1 со смещением в одну строку и т.д. Так как в таблице на листе 1.4 все значения равны 0, то она копироваться не должна. Значения равные 0 могут быть в любой таблице, нужна проверка, что заполнена ячейка «С6». Также прошу помощи в проверке макроса, который я нашел и переделал немного под себя. Он работает нормально, если только имеется значение в первом столбце. Пример прилагаю. Можете ли вы помочь с написанием макроса? Спасибо.Exsodus
Макрос для копирования таблиц без учета скрытых строк.
[[vba]
Код
Sub MacrosCopyWithoutHidden() Dim i As Long Dim iLastRow As Long Dim iLR As Long Dim Wsh As Worksheet Dim List2 As Worksheet Set List2 = ThisWorkbook.Worksheets("Лист2") List2.Cells.Clear 'очищаем Лист2 For Each Wsh In Worksheets 'цикл по листам, кроме Лист2 If Wsh.Name <> "Лист2" Then With Wsh If Left(Wsh.Name, 1) = "1" Then iLR = .Cells(.Rows.Count, "B").End(xlUp).Row If iLR >= 6 Then iLastRow = List2.Cells(Rows.Count, "B").End(xlUp).Row + 2 .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy List2.Cells(iLastRow, 2).PasteSpecial xlPasteColumnWidths List2.Cells(iLastRow, 2).PasteSpecial xlPasteAll End If Else iLR = .Cells(.Rows.Count, "B").End(xlUp).Row If iLR >= 6 Then iLastRow = List2.Cells(Rows.Count, "F").End(xlUp).Row + 2 .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy List2.Cells(iLastRow, 6).PasteSpecial xlPasteColumnWidths List2.Cells(iLastRow, 6).PasteSpecial xlPasteAll End If End If End With End If Next List2.Activate List2.Range("A1").Activate End Sub
[/vba]
Цитата
Макрос для копирования таблиц без учета скрытых строк.
[[vba]
Код
Sub MacrosCopyWithoutHidden() Dim i As Long Dim iLastRow As Long Dim iLR As Long Dim Wsh As Worksheet Dim List2 As Worksheet Set List2 = ThisWorkbook.Worksheets("Лист2") List2.Cells.Clear 'очищаем Лист2 For Each Wsh In Worksheets 'цикл по листам, кроме Лист2 If Wsh.Name <> "Лист2" Then With Wsh If Left(Wsh.Name, 1) = "1" Then iLR = .Cells(.Rows.Count, "B").End(xlUp).Row If iLR >= 6 Then iLastRow = List2.Cells(Rows.Count, "B").End(xlUp).Row + 2 .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy List2.Cells(iLastRow, 2).PasteSpecial xlPasteColumnWidths List2.Cells(iLastRow, 2).PasteSpecial xlPasteAll End If Else iLR = .Cells(.Rows.Count, "B").End(xlUp).Row If iLR >= 6 Then iLastRow = List2.Cells(Rows.Count, "F").End(xlUp).Row + 2 .Range("B2:D" & iLR).SpecialCells(xlCellTypeVisible).Copy List2.Cells(iLastRow, 6).PasteSpecial xlPasteColumnWidths List2.Cells(iLastRow, 6).PasteSpecial xlPasteAll End If End If End With End If Next List2.Activate List2.Range("A1").Activate End Sub
Ещё вариант В именах листов должен быть разделитель "," и начинаться они должны с числа [vba]
Код
Sub Copyr() Dim pst As Range, cop As Range, ws As Worksheet, r1 As Integer, r2 As Integer, s As Variant Range("A:L").Clear For Each ws In ActiveWorkbook.Worksheets s = Split(ws.Name, ",") If UBound(s) > 0 Then r1 = ws.Cells(Rows.Count, 2).End(xlUp).Row Set cop = ws.Range("B2:D" & r1) If cop.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Or cop.Rows.Count > 4 Then r2 = Worksheets("Лист2").Cells(Rows.Count, (s(0) + (s(0) - 1) * 3) + 1).End(xlUp).Row + 2 Set pst = Worksheets("Лист2").Cells(r2, (s(0) + (s(0) - 1) * 3) + 1) cop.SpecialCells(xlCellTypeVisible).Copy Destination:=pst Application.CutCopyMode = False End If End If Next End Sub
[/vba]
Ещё вариант В именах листов должен быть разделитель "," и начинаться они должны с числа [vba]
Код
Sub Copyr() Dim pst As Range, cop As Range, ws As Worksheet, r1 As Integer, r2 As Integer, s As Variant Range("A:L").Clear For Each ws In ActiveWorkbook.Worksheets s = Split(ws.Name, ",") If UBound(s) > 0 Then r1 = ws.Cells(Rows.Count, 2).End(xlUp).Row Set cop = ws.Range("B2:D" & r1) If cop.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Or cop.Rows.Count > 4 Then r2 = Worksheets("Лист2").Cells(Rows.Count, (s(0) + (s(0) - 1) * 3) + 1).End(xlUp).Row + 2 Set pst = Worksheets("Лист2").Cells(r2, (s(0) + (s(0) - 1) * 3) + 1) cop.SpecialCells(xlCellTypeVisible).Copy Destination:=pst Application.CutCopyMode = False End If End If Next End Sub
Здравствуйте, спасибо. А как правильно в этой строке указать, что нужно конкретно очищать "Лист2"? Макрос может запускаться с других листов. И можно ли указать диапазон очистки, вверху у меня шапка с описанием будет. Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения? Спасибо.
Здравствуйте, спасибо. А как правильно в этой строке указать, что нужно конкретно очищать "Лист2"? Макрос может запускаться с других листов. И можно ли указать диапазон очистки, вверху у меня шапка с описанием будет. Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения? Спасибо.Exsodus
Сообщение отредактировал Exsodus - Пятница, 07.10.2022, 19:37
[/vba] Если нужно очистить определенный диапазон именно на определенном листе то так: "Range("A:L")" можете заменить на нужный Вам диапазон, например Range("A1:L10") [vba]
Код
Worksheets("Лист2").Range("A:L").Clear
[/vba] Если напишите так [vba]
Код
Worksheets("Лист2").Range("A1:L10").Clear
[/vba] то будет очищать не столбцы целиком, а только диапазон "A1:L10"
Можете подсказать, почему мой макрос для скрытия строк работает только тогда, когда в первом столбце есть значения
Почитайте справку UsedRange Попробуйте запустить макрос ниже, со значением в первом столбце и без оного, и посмотрите, что он будет выделять [vba]
Код
Sub Test() ActiveSheet.UsedRange.Select End Sub
[/vba] Замените строку Вашего кода [vba]
Код
For Each cell In Sheets(i).UsedRange.Columns(3).Cells
[/vba] на [vba]
Код
For Each cell In Application.Intersect(Sheets(i).UsedRange, Sheets(i).Columns(3))
[/vba]
Если нужно очистить весь лист, то [vba]
Код
Worksheets("Лист2").Cells.Clear
[/vba] Если нужно очистить определенный диапазон именно на определенном листе то так: "Range("A:L")" можете заменить на нужный Вам диапазон, например Range("A1:L10") [vba]
Код
Worksheets("Лист2").Range("A:L").Clear
[/vba] Если напишите так [vba]
Код
Worksheets("Лист2").Range("A1:L10").Clear
[/vba] то будет очищать не столбцы целиком, а только диапазон "A1:L10"
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
