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
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