Страницы: 1
RSS
Макрос: копирование отфильтрованного диапазона и вставка в конец таблицы
 
Добрый день!

Помогите, пожалуйста, с написанием макроса, выполняющего следующую функции:
- макрос фильтрует умную таблицу по первому столбцу, искомое значение задается в ячейке I9
Код
ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:=Cells(1, 9)

- макрос копирует найденные по фильтру строки и вставляет их в конец таблицы (сразу после последнего заполненного значения) как значения.
Вот тут у меня было несколько вариантов и все не дают нужного результата..

Как только не пробовал - все время получается ерунда.

Заранее спасибо.
 
файл пример с вашими потугами.
 
Прошу прощения, сейчас нет возможности отправить файл, сделаю это вечером.

Код выглядел так
Код
Sub Copy()
    Dim Rng As Range
    Set Rng = ActiveSheet.Range("A:G")
    
     With ActiveSheet.AutoFilter.Range
         Set Rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
    
     End With

     With Worksheets("Лист1")
           Rng.Copy Destination:=.Range("A1")   - вот на этом этапе надо сделать так, чтобы скопированный отфильтрованный диапазон вставлялся в конец таблицы
     End With   
End Sub
 
Нашел решение!

Возможно, не самое оптимальное, но вполне рабочее
Sub Find_copy_p()Dim Rng As Range
Set Rng = ActiveSheet.Range("A:Q")
If Range("J1:O1435").EntireColumn.Hidden = True Then
       Range("J1:O1435").EntireColumn.Hidden = False
   Else
       Range("J1:O1435").EntireColumn.Hidden = False
   End If


ActiveSheet.ListObjects("Òàáëèöà1").Range.AutoFilter Field:=1, Criteria1:=Cells(1, 9)


With ActiveSheet.AutoFilter.Range
Set Rng = .Offset(1, 0).Resize(.Rows.Count - 2, .Columns.Count).SpecialCells(xlCellTypeVisible)
   
End With


With Worksheets("Planning_Matrix v1.0")
Rng.Copy
   .ShowAllData
     '  Range("A3").Select
      ' Selection.End(xlDown).Select
       ' ActiveCell.Offset(1, 0).Range("A1").Select
Rng.Select
Rng.Copy
       Range("A4").Select
       Selection.End(xlDown).Select
       ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial xlPasteValues


Application.CutCopyMode = False


End With
   
End Sub
 
Artmart, сравните вид кода в Ваших последнем и предпоследнем сообщениях.
Вернитесь, приведите сообщение в порядок. Зачем в макросе по несколько пустых строк? Оформление кода - кнопка <...>
Страницы: 1
Наверх