Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Перенос данных с листа в умную таблицу на другом листе и выделить скопированные цветом
 
Доброго времени суток, так как новичок в VBA прошу помощи в следующей задаче. Есть лист куда добавляются данные и их по 2 заданным условиям с помощью фильтра необходимо перенести в умную таблицу и после скопированные данные выделить цветом.


Код
Sheets("Платёжки"). Select
Range("A1:AZ" & Cells(Rows. Count, "A"). End(xlUp). Row. AutoFilter Field:=51, Criterial:="ОМС"
Range("A1:AZ" & Cells(Rows. Count, "A"). End(xlUp). Row. AutoFilter Field:=1, Operator:= _ xlFilterNoFill
Range(Cells(2,49),Cells(Cells(Row.Count,49).End(xlUp).Row,1)).Copy
Sheets("ОМС"). Select
ActiveSheet. ListObjects ("ОМС").Range.AutoFilter Field:=1, Criterial:="="
ActiveSheet. ListObjects("ОМС").DataBidyRange(1,1).PasteSpecial
Sheets("Платёжки").Select
Range(Cells(2,49),Cells(Cells(Row.Count,49).End(xlUp).Row,1)).Select
With Selection. Interior. Color=5287936
End With


Но выдаёт ошибку, через раз, что "Метод Pastspecial из класса Range завершён неверно"
Ошибка скорей всего из-за того, что скопированные данные не попадают в буфер, но как это исправить, я со своим небольшим опытом в VBA не знаю, помогите пожалуйста, спасибо.
Изменено: Дмитрий К - 03.02.2021 11:47:41
Использование массива со справочником по нескольким условиям
 
Доброго времени суток.
Нужна помощь на форуме нашёл тему, но ввиду начинающего опыта в вба не могу до конца понять как написать макрос.
Задача стоит такая:
Во вложенном файле два листа, на листе "текущие" значения с которыми работаем, на листе "новые" значения, которые добавляются и могут содержать значения, которые уже есть на листе "текущие".
Чтобы не использовать формулу ИНДЕКС(ПОИСКПОЗ) так как значений очень много и процесс занимает долгое время, а использовать макрос vba с массивом и справочником.
Нужно на листе "новые" добавить ячейку и по 4 условиям отобразить какие уже есть на листе "текущие", чтобы взять только новые значения.
Код
Sub новые_решения()  
   Dim a(), b(), с(), d() , lLastrow As Long, i As Long  
   
   With Sheets("новые")  
       lLastrow = .Cells(Rows.Count, 10).End(xlUp).Row  
       a = Range(.[j2], .Range("C" & lLastrow)).Value
       ReDim aa(1 To UBound(a), 1 To 1)  
   End With  
 
   With Sheets("текущие")  
       lLastrow = .Cells(Rows.Count, 10).End(xlUp).Row  
       b = Range(.[j2], .Range("J" & lLastrow)).Value
       c = Range(.[t2], .Range("T" & lLastrow)).Value
   End With  
 
 
   
   With CreateObject("Scripting.Dictionary")  
       .CompareMode = 1  
 
       
       For i = 1 To UBound(a): .Item(Trim(a(i, 1))) = i: Next  
 
       
       For i = 1 To UBound(b)  
           If .exists(Trim(b(i, 1))) Then  
               aa(.Item(Trim(b(i, 1))), 1) = b(i, 1)  
           End If  
       Next  
 
   End With  
 
   
   Sheets("текущие").[I2].Resize(UBound(aa), 1) = aa
 
End Sub
Страницы: 1
Наверх