Sub fast() original_col = 26 original_row = 106 Do Until original_col = 1 cut_number = copy_cut(original_row, original_col) original_col = original_col - cut_number If original_col = 1 Then Exit Do End If Loop ActiveSheet.Copy after:=ActiveSheet For r = 2 To 106 If Cells(r, 1).Interior.ColorIndex <> 3 Then Cells(r, 1).EntireRow.Hidden = True End If Next r End Sub Function copy_cut(data_row, data_col) ActiveSheet.Copy after:=ActiveSheet wafer_min = 100 For col = 2 To data_col find_min = Cells(data_row + 1, col) If find_min < wafer_min Then wafer_min = find_min min_col = col End If Next col Cells(data_row + 2, 1) = min_col machine_max = 0 For r = 2 To data_row if_index_one = Cells(r, min_col) If if_index_one = 1 Then find_max = Cells(r, data_col + 1) If find_max > machine_max Then machine_max = find_max max_row = r End If End If Next r Cells(data_row + 2, 2) = max_row Cells(max_row, 1).Select Selection.Interior.Color = RGB(255, 0, 0) 'ActiveSheet.Copy after:=ActiveSheet sum_hidden_col = 0 For col = 2 To data_col If Cells(max_row, col) = 1 Then Cells(max_row, col).EntireColumn.Hidden = True sum_hidden_col = sum_hidden_col + 1 End If Next col del_hidden copy_cut = sum_hidden_col End Function Sub del_hidden() On Error Resume Next For Each cell In ActiveSheet.UsedRange If cell.EntireRow.Hidden Then cell.Delete 3 End If If cell.EntireColumn.Hidden Then cell.Delete 4 End If Next On Error GoTo 0 End Sub