Правильно первая строка попадает - это шапка для фильтра получается, она не фильтруется
Уберите Селекты - не будет зависеть от выделения
Если выриантов только два (или заранее известное небольшое количество), то вот так можно
[vba]Код
Sub sortpc()
Dim ar(1 To 2)
Application.ScreenUpdating = 0
ar(1) = "dvs"
ar(2) = "des"
Range("A1").EntireRow.Insert
r1_ = Cells(Rows.Count, 1).End(3).Row
For i = 1 To UBound(ar)
Range("A1:K" & r1_).AutoFilter Field:=2, Criteria1:="=*" & ar(i)
With Sheets(ar(i))
.UsedRange.Clear
Range("A2:K" & r1_).Copy .Range("A1")
End With
Next i
Range("A1").EntireRow.Delete
Application.ScreenUpdating = 1
MsgBox "Данные перенесены"
End Sub
[/vba]
Если больше или произвольно, то сначала нужно получить массив ar уникальных по столбцу В, а потом все остальное. И проверку на наличие нужного листа еще заодно делать нужно.
Но Вы сначала с этим разберитесь
* Файл перевложил - забыл кнопке макрос назначить