Micrsoft Excel has stopped working

[Elikki]

Hi,
I am new and this is my first post.
I wrote a VBA code using excel 2010 and every time I run it, I get this error, "Microsoft Excel Has Stopped working". The thing is if I run it from the module, it works fine, but if I click on the button to which a macro is assigned the error popes up. The code is as follows.

Sub CustContact()
 Call FileOpenContact
End Sub

Sub FileOpenContact()

Dim Path            As String
Dim FileName        As String
Dim Wkb             As Workbook
Dim ws              As Worksheet
Dim FolderName      As Variant
Dim Dates           As String


    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = "C:\?????\Desktop\?????" 'Change as needed
    FileName = Dir(Path & "\?????????????????.xlsx", vbNormal)
    On Error Resume Next
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each ws In Wkb.Worksheets
            ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next ws
        Wkb.Close False
        FileName = Dir()
    On Error Resume Next
    Loop
      Call SelcectCode
End Sub

Sub SelcectCode()

Dim x As Integer, code As String

    Sheets("Codes").Activate
    
    lr = Range("A" & Rows.Count).End(xlUp).Row

        For x = 1 To lr
            If Range("B1").Value = 1 Then
            ElseIf Range("B1").Value = x Then
                code = Cells(x, 1)
                Exit For
            End If
        Next x
        FindContact code
End Sub

Sub FindContact(ByRef code)

Dim x As Integer

    Sheets("Customer").Activate
     ActiveSheet.Name = code
    
    lr = Range("A" & Rows.Count).End(xlUp).Row

        For x = lr To 2 Step -1
            If Cells(x, 3) = code Then
            Else
                Cells(x, 1).EntireRow.Delete
            End If
        Next x
        Columns("B").Delete
        Columns("C:H").Delete
        Columns("Q").Delete
        Columns("R:T").Delete
End Sub

Thanks in advance!