Коллеги добрый день, помогите пожалуйста актуализировать макрос.
В файле, при совпадении в столбце F - Заказ или Отказ вся строка переносится (с удалением на первичном листе) в соответствующие листы "Заказ" и "Отказ" (как бы создавая из заново каждый раз) Проблема в том, что с каждым обновлением (нажатие кнопки) макрос удаляет прошлые данные и заменяет на новые на листах Заказ, Отказ А так как это действующий файл и постоянно будет пополняться, то мне важно сохранять все данные и продолжать вести учет.
Подскажите плжт, как можно или нужно изменить макрос. [vba]
Код
Sub Main() Dim ws As Worksheet, z As Range, x Application.ScreenUpdating = False: Application.DisplayAlerts = False Set ws = ActiveSheet: ws.AutoFilterMode = False For Each x In Array("Заказ", "Отказ") On Error Resume Next: Sheets(x).Delete: On Error GoTo 0 Sheets.Add after:=Sheets(Sheets.Count): ActiveSheet.Name = x ws.[A:F].Copy: [A:F].PasteSpecial Paste:=xlPasteColumnWidths ws.Rows("1:2").Copy Rows("1:2") ws.[f:f].AutoFilter Field:=1, Criteria1:=x Set z = ws.AutoFilter.Range.Offset(2).SpecialCells(12).EntireRow z.Copy [A3]: [A1].Select: z.Delete: ws.ShowAllData Next ws.Activate: ws.AutoFilterMode = False End Sub
[/vba]
Коллеги добрый день, помогите пожалуйста актуализировать макрос.
В файле, при совпадении в столбце F - Заказ или Отказ вся строка переносится (с удалением на первичном листе) в соответствующие листы "Заказ" и "Отказ" (как бы создавая из заново каждый раз) Проблема в том, что с каждым обновлением (нажатие кнопки) макрос удаляет прошлые данные и заменяет на новые на листах Заказ, Отказ А так как это действующий файл и постоянно будет пополняться, то мне важно сохранять все данные и продолжать вести учет.
Подскажите плжт, как можно или нужно изменить макрос. [vba]
Код
Sub Main() Dim ws As Worksheet, z As Range, x Application.ScreenUpdating = False: Application.DisplayAlerts = False Set ws = ActiveSheet: ws.AutoFilterMode = False For Each x In Array("Заказ", "Отказ") On Error Resume Next: Sheets(x).Delete: On Error GoTo 0 Sheets.Add after:=Sheets(Sheets.Count): ActiveSheet.Name = x ws.[A:F].Copy: [A:F].PasteSpecial Paste:=xlPasteColumnWidths ws.Rows("1:2").Copy Rows("1:2") ws.[f:f].AutoFilter Field:=1, Criteria1:=x Set z = ws.AutoFilter.Range.Offset(2).SpecialCells(12).EntireRow z.Copy [A3]: [A1].Select: z.Delete: ws.ShowAllData Next ws.Activate: ws.AutoFilterMode = False End Sub
Pelena, не работает. Один раз да, дополняет строки - круто и как надо. Но если еще раз вписать и обновить - то перезаписывает поверх внесенных в предыдущий раз ( но те, которые были до этого остаются).
Pelena, не работает. Один раз да, дополняет строки - круто и как надо. Но если еще раз вписать и обновить - то перезаписывает поверх внесенных в предыдущий раз ( но те, которые были до этого остаются).EvA80
Сообщение отредактировал EvA80 - Среда, 04.09.2019, 12:59