ordenar filas por múltiples escenarios

Estoy tratando de ordenar filas en función de múltiples valores. En este ejemplo, estoy tratando de separar el "Producto SN" correspondiente (Columna M) y el "Nombre CE" (Columna L) que tienen un Código de acción "220 - Componente reemplazado" (Columna N) en una hoja y las que no tienen " 220 "en otra hoja.

P.ej

• C-666 LC011169 no tiene un "220" presente y debe estar en una hoja
• C-958 LC011169 tiene un "220" y debe estar en su propia hoja

Sé que esto puede parecer confuso, pero tendré que clasificar cientos de líneas de pedido como esta todos los días y estoy trabajando para simplificar el proceso.

Una versión simplificada se vería como la imagen de abajo (donde X = Reemplazado ):

Para ir aún más lejos, estoy tratando de combinar los "códigos de síntomas" (columna O) una vez que se completa la primera operación. Este es mi objetivo final donde los Símbolos son los Síntomas :

Experimenté con algunos VBA para ordenar y copiar.

Consulte el archivo xlsm vinculado al final para obtener más información.

Entonces, lo que tenemos aquí es un código VBA que clasifica la información original (simplemente copiando, sin tocar la lista original) en tres tablas nuevas.

Que hace:

• Recorre toda la tabla original.
• Copia cada fila en una tabla nueva, predefinida y existente en una hoja diferente.

Lo que no hace:

• Verificar duplicados
• Crea nuevas tablas.

También incluye una macro para borrar las tablas ordenadas. Esto también se puede usar para borrar las tablas antes de ordenar por segunda vez, para evitar duplicados.

Código de clasificación (lo más probable es que esto se pueda mejorar, pero se está haciendo tarde):

Sub sortToTables()
    Dim i, iLastRow As Integer
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim Replaced As String, Burn As String, Repurpose As String
    iLastRow = Worksheets("Sheet1").ListObjects("Table1").ListRows.Count

    Replaced = "220 - Replaced Component"
    Burn = "C990 - Advised to burn"
    Repurpose = "130 - Repurpose"
    Application.ScreenUpdating = False
    For i = 1 To iLastRow
        If Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13) = Replaced Then
        Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
        Set oLastRow = Worksheets("220").ListObjects("Table16").ListRows.Add
        srcRow.Copy
        oLastRow.Range.PasteSpecial xlPasteValues

        ElseIf Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13) = Burn Then
        Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
        Set oLastRow = Worksheets("C990").ListObjects("Table17").ListRows.Add
        srcRow.Copy
        oLastRow.Range.PasteSpecial xlPasteValues

        ElseIf Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13) = Repurpose Then
        Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
        Set oLastRow = Worksheets("130").ListObjects("Table18").ListRows.Add
        srcRow.Copy
        oLastRow.Range.PasteSpecial xlPasteValues
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Código para limpiar las tablas:

Sub ResetTable()

Dim tbl As ListObject, tbl2 As ListObject, tbl3 As ListObject

Set tbl = Worksheets("220").ListObjects("Table16")
Set tbl2 = Worksheets("C990").ListObjects("Table17")
Set tbl3 = Worksheets("130").ListObjects("Table18")


  If tbl.ListRows.Count >= 1 Then
    tbl.DataBodyRange.Delete
  End If

  If tbl2.ListRows.Count >= 1 Then
    tbl2.DataBodyRange.Delete
  End If

  If tbl3.ListRows.Count >= 1 Then
    tbl3.DataBodyRange.Delete
  End If

End Sub

Archivo: https://drive.google.com/open?id=0B_8icTMsheWfTUV0YjJCaElmTkU

EDITAR

Actualice el código para hacer lo que comentó (creo):

Sub sortToTables()
    Dim i, iLastRow As Integer
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim Replaced As String, Burn As String, Repurpose As String
    iLastRow = Worksheets("Sheet1").ListObjects("Table1").ListRows.Count

    Application.ScreenUpdating = False
    For i = 1 To iLastRow

        If Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 11) = "C-235" And _
            Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 12) = "LC0001234" And _
            (InStr(1, Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13), "220") Or _
            InStr(1, Worksheets("Sheet1").ListObjects("Table1").DataBodyRange(i, 13), "221")) Then

            Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
            Set oLastRow = Worksheets("220").ListObjects("Table16").ListRows.Add
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValues
        Else
            Set srcRow = Worksheets("Sheet1").ListObjects("Table1").ListRows(i).Range
            Set oLastRow = Worksheets("C990").ListObjects("Table17").ListRows.Add
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValues

        End If
    Next
    Application.ScreenUpdating = True
End Sub

Como puede ver aquí, utilizo Instrpara obtener una coincidencia parcial en una cadena, en lugar de un valor absoluto, ya que la celda contiene más que solo el número.

Si desea verificar, por ejemplo, diferentes números de serie, puede asignar ese valor a una variable e ingresar el número de serie que desea ordenar en un cuadro de texto.

No me molesté en cambiar el nombre de las hojas, pero solo uso dos de las hojas en este ejemplo.

Aclaración sobre cómo escribir la declaración If: observe el paréntesis alrededor de OR:

If ref(x,y) = "string" And ref(x,y2) = "another string" And (ref(x,y3) ="this" Or (ref(x,y3) ="that") Then

   Do stuff

Else '(Or ElseIf)

   Do something else

End If