Necesito mejorar una macro para traspasar filas según una columna

Hola, requiero de su ayuda nuevamente, tengo esta macro que cada vez que cambia una celda en la columna F, traspasa esta fila completa hacia esa hoja, por ejemplo si en la hoja "BALMACEDA", todos los valores de la columna F son "BALMACEDA" pero si una de esas celdas cambia a "CASA MATRIZ" esa fila completa se va a la hoja CASA MATRIZ, les dejo la macro para que la miren, va en cada hoja, saludos

Private Sub Worksheet_Change(ByVal Target As Range) 
'desactiva el refresco/parpadeo de la pantalla 
Application.ScreenUpdating = False 
'si hay algun error, que salte el mismo 
On Error Resume Next 
'desde la columna 6 "osea F" se correra la condicion, si no que salga de la rutina 
If Target.Column <> 6 Then Exit Sub 
'si en la columna 6 se encuentran los criterios, entonces que mueva la fila a la hoja 
If UCase(Target) = "VICUNA_E249" Then 
Sheets("VICUNA_E249").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("VICUNA_E249").Rows(3) 
End If 
If UCase(Target) = "VALLENAR_E250" Then 
Sheets("VALLENAR_E250").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("VALLENAR_E250").Rows(3) 
End If 
If UCase(Target) = "SALAMANCA_E251" Then 
Sheets("SALAMANCA_E251").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("SALAMANCA_E251").Rows(3) 
End If 
If UCase(Target) = "OVALLE_E252" Then 
Sheets("OVALLE_E252").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("OVALLE_E252").Rows(3) 
End If 
If UCase(Target) = "SALVADOR_E253" Then 
Sheets("SALVADOR_E253").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("SALVADOR_E253").Rows(3) 
End If 
If UCase(Target) = "COQUIMBO_E254" Then 
Sheets("COQUIMBO_E254").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("COQUIMBO_E254").Rows(3) 
End If 
If UCase(Target) = "COQUIMBO_E255" Then 
Sheets("COQUIMBO_E255").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("COQUIMBO_E255").Rows(3) 
End If 
If UCase(Target) = "COPIAPO_E256" Then 
Sheets("COPIAPO_E256").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("COPIAPO_E256").Rows(3) 
End If 
If UCase(Target) = "CHANARAL_E257" Then 
Sheets("CHANARAL_E257").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("CHANARAL_E257").Rows(3) 
End If 
If UCase(Target) = "BALMACEDA" Then 
Sheets("BALMACEDA").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("BALMACEDA").Rows(3) 
End If 
If UCase(Target) = "EJECUTIVO" Then 
Sheets("EJECUTIVO").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("EJECUTIVO").Rows(3) 
End If 
If UCase(Target) = "ENTEL" Then 
Sheets("ENTEL").Rows(3).Insert 
ActiveSheet.Rows(Target.Row).Cut 
Sheets("ENTEL").Rows(3) 
End If 
'se delimita el rango para eliminar las filas que quedan vacias 
ul = Range("F" & Rows.Count).End(xlUp).Row 
With Sheets("Hoja1") 
For gp = ul To 1 Step -1 
If Cells(gp, 6) = "" Then Rows(gp).Delete 
Next 
End With 
'desactiva cualqiuer error activado 
On Error GoTo 0 
'activa la pantalla nuevamente 
Application.ScreenUpdating = True 
End Sub

Añade tu respuesta

Haz clic para o