Cargar datos en hojas según día y familias en Excel

Solicito su ayuda nuevamente lo que necesito son cuadros de requerimientos uno de perecibles y otro de no perecibles pero de toda una semana de lunes a domingo.

Por ejemplo en la hoja "PROD_BD" filtre primero por día primero "LUNES" y luego familia en este caso solo hay dos "PERECIBLES" y "NO PERECIBLES" y que luego estos datos se copien según, los productos perecibles se copien en la hoja "PERECIBLES" y los productos no perecibles en la hoja no perecibles y que siga el ciclo de toda la semana de LUNES a DOMINGO el código que le he ingresado es muy largo por ello solicito su ayuda para poder reducir el código

Este es la hoja principal y como puede ver están en la columna "P" los días de la semana y en la columna "O" la familia

Este es código que estado utilizado pero es muy largo para lograr el resultado me puede ayudar a simplificarlo

 dato = "LUNES"
   ' dato
    Hoja8.ListObjects("TABLA1").Range.AutoFilter field:=16, Criteria1:=dato, Operator:=xlFilterValues
    Hoja8.Select
    Range("Tabla1[DIA SEMANA]").Select
    Selection.Copy
    Sheets("Perecibles").Select
    Range("a4").Select
    countult = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PROD_BD").Select
    Range("Tabla1[DESCRIPCIÓN]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Perecibles").Select
        Sheets("Perecibles").Select
    Range("a4").Select
    countult = Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
    Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Select
    'Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PROD_BD").Select
    Range("Tabla1[RECETAS]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Perecibles").Select
        Sheets("Perecibles").Select
    Range("a4").Select
    countult = Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
    Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
    'Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PROD_BD").Select
    Range("Tabla1[U.M.]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Perecibles").Select
        Sheets("Perecibles").Select
    Range("a4").Select
    countult = Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row
    Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
    'Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PROD_BD").Select
    Range("Tabla1[GUÍA DE PEDIDO]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Perecibles").Select
        Sheets("Perecibles").Select
    Range("a4").Select
    countult = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
    Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
    'Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Call Linea

y este es el resultado que he obtenido el código hace que filtre el día de la semana y la familia y que luego esta información se pegue en la hojas si los productos son perecibles en la hoja que corresponden y los no perecibles en la hoja que corresponde este código es solo para filtrar 1 día faltan agregar los otros día de la semana pero seria mucho mas largo me puede ayudar a simplificarlo

Gracias por la atención prestada

Slds

Robert