Вообщем, пока ждал ответа нашел информацию в инете выкладываю макрос здесь может кому понадобится
| Код |
|---|
Sub ОтборКоманд()
Dim vItem, avArr, li As Long
ReDim avArr(1 To Rows.Count, 1 To 1)
With New Collection
On Error Resume Next
For Each vItem In Range("B2", Cells(Rows.Count, 2).End(xlUp)).Value
'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А
.Add vItem, CStr(vItem)
If Err = 0 Then
li = li + 1: avArr(li, 1) = vItem
Else: Err.Clear
End If
Next
End With
If li Then ActiveWorkbook.Sheets("Лист2").Cells(1, 1).Resize(li).Value = avArr
' heets("2").Range("D7").AutoFill Destination:=Sheets("2").Range("D7:D8"), Type:=xlFillDefault
End Sub |
