Страницы: 1
RSS
макрос копирования и удаления отфильтрованных строк
 
Добрый вечер!)
Задача такая: в первой таблице автофильтром выделяем строки с нулевым значением в ячейке. Эти строки переносим во вторую таблицу, а в первой удаляем.
Я написала макрос, частично рекордером, частично дописала сортировку, он работает, но..в нем вставлен от рекордера конкретный диапазон отфильтрованной строки.
Range("A9:J9")
Нужно чтобы был не конкретный диапазон, а диапазон применяемый ко всей таблице. (количество строк же будет добавляться в ней)
Подскажите плизз, что нужно исправить в моем макросе?
Код
Sub удаление_в_архив()
'
'

'Application.ScreenUpdating = False
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10, Criteria1:="0,00"
    Range("A9:J9").Select
    Selection.Copy
    Sheets("архив").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A2:J100000").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("архив").Sort
        .SetRange Range("A2:J100000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    Sheets("прайс").Select
    Range("A9:J9").Select
    Selection.ClearContents
     Selection.EntireRow.Delete
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10
    Application.ScreenUpdating = True
End Sub
 
о.. нашла таки правильное решение))
но наверное таки все равно что то лишнее в коде есть...)
Код
Sub удаление_в_архив2()
'
'

 Application.ScreenUpdating = False
 Set ws = ActiveSheet
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10, Criteria1:="0,00"
     Set mr = ws.AutoFilter.Range.Offset(1, 1). _
        Resize(ws.AutoFilter.Range.Rows.Count - 1, ws.AutoFilter.Range.Columns.Count)
    mr.SpecialCells(xlCellTypeVisible).EntireRow.Select
    Selection.Copy
    Sheets("архив").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A2:J100000").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("архив").Sort
        .SetRange Range("A2:J100000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    Sheets("прайс").Select
    mr.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10
    Application.ScreenUpdating = True
End Sub
Изменено: Просто Ledi - 10.01.2017 23:28:52
Страницы: 1
Наверх