Здравствуйте, помогите пж настроить автоматическое копирование строк из листа "Общие расходы" на листы с соответствующим названием. Т.е. если в листе "Общие расходы" в колонке с названием "отдел" появится "Маркетинг", то перенести строку целиком в соответствующий лист "Маркетинг". По аналогии с другими отделами. Пытался самостоятельно все сделать - ничего не вышло
Здравствуйте, помогите пж настроить автоматическое копирование строк из листа "Общие расходы" на листы с соответствующим названием. Т.е. если в листе "Общие расходы" в колонке с названием "отдел" появится "Маркетинг", то перенести строку целиком в соответствующий лист "Маркетинг". По аналогии с другими отделами. Пытался самостоятельно все сделать - ничего не вышлоvidny-ivan
Sub ptrenos() Dim dd_&, dd1_&, ddl_1 Dim sh As Worksheet Dim rr_ As String dd_ = Sheets("Общие расходы").Cells(Rows.Count, 1).End(xlUp).Row
For Each sh In Sheets If sh.Name <> "Общие расходы" Then rr_ = sh.Name ddl_1 = Sheets(rr_).Cells(Rows.Count, 1).End(xlUp).Row Sheets(rr_).Range("$A$3:$F$" & ddl_1 + 1).ClearContents
Sheets("Общие расходы").Range("$A$2:$F$" & dd_).AutoFilter Field:=4, Criteria1:=rr_ dd1_ = Sheets("Общие расходы").Cells(Rows.Count, 1).End(xlUp).Row dd1_ = Sheets("Общие расходы").Range("A3:E" & dd1_).SpecialCells(xlCellTypeVisible).Copy With Sheets(rr_).Range("A3") .PasteSpecial Paste:=xlPasteValues End With End If
Next sh Sheets("Общие расходы").Range("$A$2:$F$" & dd_).AutoFilter End Sub
[/vba]
так надо? [vba]
Код
Option Explicit
Sub ptrenos() Dim dd_&, dd1_&, ddl_1 Dim sh As Worksheet Dim rr_ As String dd_ = Sheets("Общие расходы").Cells(Rows.Count, 1).End(xlUp).Row
For Each sh In Sheets If sh.Name <> "Общие расходы" Then rr_ = sh.Name ddl_1 = Sheets(rr_).Cells(Rows.Count, 1).End(xlUp).Row Sheets(rr_).Range("$A$3:$F$" & ddl_1 + 1).ClearContents
Sheets("Общие расходы").Range("$A$2:$F$" & dd_).AutoFilter Field:=4, Criteria1:=rr_ dd1_ = Sheets("Общие расходы").Cells(Rows.Count, 1).End(xlUp).Row dd1_ = Sheets("Общие расходы").Range("A3:E" & dd1_).SpecialCells(xlCellTypeVisible).Copy With Sheets(rr_).Range("A3") .PasteSpecial Paste:=xlPasteValues End With End If
Next sh Sheets("Общие расходы").Range("$A$2:$F$" & dd_).AutoFilter End Sub
Благодарю за помощь! К сожалению я не знал, что макросы не работают если к файлу открываешь общий доступ... Можно ли через условное форматирование создать правило, а не макрос?
Благодарю за помощь! К сожалению я не знал, что макросы не работают если к файлу открываешь общий доступ... Можно ли через условное форматирование создать правило, а не макрос?vidny-ivan
Сообщение отредактировал vidny-ivan - Четверг, 04.04.2019, 11:35