求助一个EXCEL VBA的问题

在当前文件夹下新建一个Excel，插入模块，复制代码，运行

Sub 遍历()
    Dim FileName As String, Path As String
    Dim wk As Workbook
    Dim sht As Worksheet
    Path = ThisWorkbook.Path & "\"
    FileName = Dir(Path & "*.xlsx*")
    Application.DisplayAlerts = False

    Do While FileName <> ""
        If FileName <> ThisWorkbook.Name Then
            Set wk = Workbooks.Open(Path & FileName)
            For Each sht In wk.Worksheets
                sht.Columns("Q:EC").Delete
                sht.Activate
                sht.Range("A1").Select
            Next sht
            wk.Close True
        End If
        FileName = Dir
    Loop
    Application.DisplayAlerts = True
    Set wk = Nothing
    Set sht = Nothing
End Sub