Próbáld ki ezt is.

Sub Auto_Open()
    Dim ws As Worksheet, Rng1 As Range, Rng2 As Range, Lap As Long, Sorok As Long
   
    For Lap = 2 To Worksheets.Count
        Set ws = ThisWorkbook.Worksheets(Lap)
        ws.Activate
        Sorok = ws.Cells.SpecialCells(xlLastCell).Row
        
        'Felfedjük mindegyiket
        ws.Rows.Hidden = False
        
        Application.ScreenUpdating = False  'Letiltjuk a képernyő frissítését
        
        'Magic is at work here...
        Set Rng1 = ws.Range("C4").Resize(Sorok)
        Set Rng2 = ws.Cells(4, ws.Columns.Count).Resize(Sorok)
        Rng1.Copy
        Rng2.PasteSpecial xlPasteValues
        Rng2.Replace what:="", replacement:=1
        
        '4. sortól rejtünk csak ha 3. oszlop értéke üres
        On Error Resume Next
        Rng2.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Hidden = True
        Application.ScreenUpdating = True
        Rng2.EntireColumn.ClearContents
        ws.Range("A1").Activate
    Next
    MsgBox ("Kész van."), vbOKOnly
End Sub