Макрос автоматического переноса строк по условию на другую страницу

[zip4eg]

Помогите пожалуйста, переносит только на страницу "Остальное" при выборе.
Ну и если есть возможность надо убрать подёргивания экрана
Вот макрос.


Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("Расходы"): .Select: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [f:f]) Is Nothing And Target.Value = "Реклама" Then .Rows(Target.Row).Copy _
Sheets("Реклама").Rows(WorksheetFun ction.CountA(Sheets("Реклама").[a:a]) + 1)
End With:
With Sheets("Расходы"): .Select: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [f:f]) Is Nothing And Target.Value = "офис" Then .Rows(Target.Row).Copy _
Sheets("Офис").Rows(WorksheetFuncti on.CountA(Sheets("Офис").[a:a]) + 1)
End With:
With Sheets("Расходы"): .Select: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [f:f]) Is Nothing And Target.Value = "Логистика" Then .Rows(Target.Row).Copy _
Sheets("Логистика").Rows(WorksheetF unction.CountA(Sheets("Логистика").[a:a]) + 1)
End With:
With Sheets("Расходы"): .Select: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [f:f]) Is Nothing And Target.Value = "Зарплата" Then .Rows(Target.Row).Copy _
Sheets("Зарплата").Rows(WorksheetFu nction.CountA(Sheets("Зарплата").[a:a]) + 1)
End With:
With Sheets("Расходы"): .Select: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [f:f]) Is Nothing And Target.Value = "остальное" Then .Rows(Target.Row).Copy _
Sheets("Остальное").Rows(WorksheetF unction.CountA(Sheets("Остальное").[a:a]) + 1)
End With: End Sub


заранее благодарен!

[Казанский]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
On Error GoTo ex_
If Not Intersect(Target, [f:f]) Is Nothing And Target <> "" Then
    With Sheets(Target.Value)
        Target.EntireRow.Copy .Rows(WorksheetFunction.CountA(.[a:a]) + 1)
    End With
End If
ex_: End Sub