Macro Run only a three lines of code and then stops working without any error messages

[John01]

I have the code that is working perfectly, but now it doesn't open the code line when comes to open the file from directory. I appreciate some help, thanks in advance. I have the following code:

Sub CENTRAL()

Dim cell3 As Range
Dim FileName As String
Dim CellName As String
Dim Fpath As String
Dim wb As Workbook
Dim SumResult As Double



Workbooks.Open FileName:="C:\Users\SKY\Desktop\Dom\CENTRAL.xlsx"




For Each cell3 In ActiveSheet.Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).row)

finalcolumn = 1 + ActiveSheet.Cells(cell3.row, 14).End(xlToLeft).Column <-- it is executing the code till here

MsgBox finalcolumn <--- to check if it is working

Fpath = ThisWorkbook.Path & "\" <----- from this part macro stops to work
CellName = cell3.Value

FileName = Dir(Fpath & "\*" & CellName & ".xlsx")
Select Case True
Case Trim(cell3.Value) = "Total"
Case Trim(cell3.Value) <> "" And Left (FileName,14) Like "*" & CellName & "*"

Workbooks.Open FileName:=Fpath & FileName
Set wb = ActiveWorkbook
SumResult = WorksheetFunction.Sum(wb.Worksheets(1).Range("B1:B6"))
Totalsum = Totalsum + SumResult

Windows("CENTRAL.xlsx").Activate
Worksheets(1).Range(Cells(cell3.row, finalcolumn), Cells(cell3.row, finalcolumn)).Value = Totalsum
Application.CutCopyMode = False
Application.DisplayAlerts = False

wb.Close



End Select

Next cell3



End Sub

 

[John01]

Tnx again for the help. The problem is solved.