troque a rotina pela a abaixo:
Adicionei somente a instrução para ir até a aba "w.Activate" uma vez que temos instruções deletando linhas que só serão executadas com o foco na aba, e a instrução "Application.ScreenUpdating" são para congelar a tela e não vermos os saltos entre as abas.

Sub consolida()
On Error GoTo erro_consolida
Dim w As Worksheet, ulinhadata As Long, ulinhatabela As Long, ulinhaprodutos As Long
Dim produto As String
Dim data As Date, qtd As Long, maiorqtd As Long
Dim matriz()
Dim wkf As WorksheetFunction

Application.ScreenUpdating = False

Set wkf = Application.WorksheetFunction
Set w = Plan1

w.Activate

w.Columns("f:xfd").Delete

w.Columns(2).Copy Destination:=w.Columns(6)
w.Columns(6).RemoveDuplicates Columns:=1, Header:=xlYes

w.Columns(3).Copy Destination:=w.Columns(8)
w.Columns(8).RemoveDuplicates Columns:=1, Header:=xlYes

w.Columns(7).Delete

ulinhadata = w.Cells(Cells.Rows.Count, 7).End(xlUp).Row
ulinhaprodutos = w.Cells(Cells.Rows.Count, 6).End(xlUp).Row
ulinhatabela = w.Cells(Cells.Rows.Count, 2).End(xlUp).Row

    For d = 2 To ulinhadata
        data = w.Cells(d, 7)
        w.Columns(5).ClearContents
        For p = 2 To ulinhaprodutos
            produto = UCase(w.Cells(p, 6))
            qtd = 0
            For i = 2 To ulinhatabela
            
                If w.Cells(i, 3) = data And UCase(w.Cells(i, 2)) = produto Then
                    qtd = qtd + 1
                    w.Cells(p, 5) = qtd
                End If
            
            Next i
        
        Next p
    
        matriz = w.Range(Cells(2, 5), Cells(ulinhaprodutos, 5))
        maiorqtd = wkf.Max(matriz)
    
        For j = 2 To ulinhaprodutos
        
            If w.Cells(j, 5) = maiorqtd Then
                w.Cells(d, 8) = w.Cells(j, 6)
        
            GoTo novo_dia
            End If
        
        
        Next j
novo_dia:
    
    Next d

    w.Columns(5).ClearContents
    w.Columns(6).ClearContents
    
    w.Cells(1, 8) = "Mais vendido"
    w.Columns.AutoFit
    w.Columns.HorizontalAlignment = xlCenter
    
    Worksheets("Principal").Select
    
    Application.ScreenUpdating = True

    Exit Sub

erro_consolida:
    MsgBox "ocorreu um erro, verifique!"
    
    Application.ScreenUpdating = True
    Worksheets("Principal").Select

End Sub

[]s

Muito obrigado.

Funcionou.