Move Files from current folder to a new subfolders specified in a column

Sub SortMoveFiles()

    Dim SourcePath As String
    Dim DestPath As String
    Dim FileName As String
    Dim LastRow As Long
    Dim i As Long
   
 '---------Write Header---------------------------
   
    Range("K1").Select
    ActiveCell.FormulaR1C1 = ".PDF"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = ".STP"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = ".DXF"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = ".STL"

    Dim folderPath As String
    Dim newfolderPath As String
    folderPath = Application.ActiveWorkbook.Path
'   folderPath = Application.ThisWorkbook.Path
    
'---------Create subfolders------------------------

    On Error Resume Next
    MkDir folderPath & Application.PathSeparator & "Machining"
    MkDir folderPath & Application.PathSeparator & "3D Printing"
    MkDir folderPath & Application.PathSeparator & "Laser Cutting"

'---------Copy PDF files to subfolders-------------

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    

    
    For i = 2 To LastRow
    
    newfolderPath = folderPath & Application.PathSeparator & Cells(i, "F")

        FileName = Cells(i, "A").Value & Cells(1, "K").Text
    
        If Right(folderPath, 1) <> Application.PathSeparator Then
            SourcePath = folderPath & Application.PathSeparator
        Else
            SourcePath = folderPath
        End If
        
        If Right(newfolderPath, 1) <> Application.PathSeparator Then
            DestPath = newfolderPath & Application.PathSeparator
        Else
            DestPath = newfolderPath
        End If
        
        If Dir(folderPath & Application.PathSeparator & FileName) = "" Then
            Cells(i, "K").Value = "Missing"
        ElseIf Dir(newfolderPath & FileName) <> "" Then
            Cells(i, "K").Value = "Already exists"
        Else
            Name folderPath & Application.PathSeparator & FileName As DestPath & FileName
            Cells(i, "K").Value = "Moved"
        End If
        
    Next i

'---------Copy STP files to subfolders-------------

     LastRowz = Cells(Rows.Count, "A").End(xlUp).Row
    

    
    For i = 2 To LastRowz
    
    newfolderPath = folderPath & Application.PathSeparator & Cells(i, "F")

        FileName = Cells(i, "A").Value & Cells(1, "L").Text
    
        If Right(folderPath, 1) <> Application.PathSeparator Then
            SourcePath = folderPath & Application.PathSeparator
        Else
            SourcePath = folderPath
        End If
        
        If Right(newfolderPath, 1) <> Application.PathSeparator Then
            DestPath = newfolderPath & Application.PathSeparator
        Else
            DestPath = newfolderPath
        End If
        
        If Dir(folderPath & Application.PathSeparator & FileName) = "" Then
            Cells(i, "L").Value = "Missing"
        ElseIf Dir(newfolderPath & FileName) <> "" Then
            Cells(i, "L").Value = "Already exists"
        Else
            Name folderPath & Application.PathSeparator & FileName As DestPath & FileName
            Cells(i, "L").Value = "Moved"
        End If
        
    Next i

'---------Copy DXF files to subfolders-------------

     LastRowz = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To LastRowz
    
    newfolderPath = folderPath & Application.PathSeparator & Cells(i, "F")

        FileName = Cells(i, "A").Value & Cells(1, "M").Text
    
        If Right(folderPath, 1) <> Application.PathSeparator Then
            SourcePath = folderPath & Application.PathSeparator
        Else
            SourcePath = folderPath
        End If
        
        If Right(newfolderPath, 1) <> Application.PathSeparator Then
            DestPath = newfolderPath & Application.PathSeparator
        Else
            DestPath = newfolderPath
        End If
        
        If Dir(folderPath & Application.PathSeparator & FileName) = "" Then
            Cells(i, "M").Value = "Missing"
        ElseIf Dir(newfolderPath & FileName) <> "" Then
            Cells(i, "M").Value = "Already exists"
        Else
            Name folderPath & Application.PathSeparator & FileName As DestPath & FileName
            Cells(i, "M").Value = "Moved"
        End If
        
    Next i

'---------Copy STL files to subfolders-------------

     LastRowz = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To LastRowz
    
    newfolderPath = folderPath & Application.PathSeparator & Cells(i, "F")

        FileName = Cells(i, "A").Value & Cells(1, "N").Text
    
        If Right(folderPath, 1) <> Application.PathSeparator Then
            SourcePath = folderPath & Application.PathSeparator
        Else
            SourcePath = folderPath
        End If
        
        If Right(newfolderPath, 1) <> Application.PathSeparator Then
            DestPath = newfolderPath & Application.PathSeparator
        Else
            DestPath = newfolderPath
        End If
        
        If Dir(folderPath & Application.PathSeparator & FileName) = "" Then
            Cells(i, "N").Value = "Missing"
        ElseIf Dir(newfolderPath & FileName) <> "" Then
            Cells(i, "N").Value = "Already exists"
        Else
            Name folderPath & Application.PathSeparator & FileName As DestPath & FileName
            Cells(i, "N").Value = "Moved"
        End If
        
    Next i

'---------Arrange & Condition last 4 columns-------------

    Columns("K:N").Select
    Selection.ColumnWidth = 9.29

'---

    Columns("K:N").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""Missing"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
'---
    
    Columns("K:N").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""Moved"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("K1").Select

    Cells.AutoFilter
    Rows("1:1").Select
    Selection.AutoFilter
'---------------------Remove unwanted status-----------
    
    For i = 2 To LastRow
    If Cells(i, "F").Value = "Comercial" Then
        Cells(i, "K").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "Comercial" Then
        Cells(i, "L").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "Comercial" Then
        Cells(i, "M").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "Comercial" Then
        Cells(i, "N").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "Machining" Then
        Cells(i, "M").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "Machining" Then
        Cells(i, "N").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "Laser Cutting" Then
        Cells(i, "N").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "3D Printing" Then
        Cells(i, "K").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "3D Printing" Then
        Cells(i, "L").ClearContents
    
    End If
    Next i

    For i = 2 To LastRow
    If Cells(i, "F").Value = "3D Printing" Then
        Cells(i, "M").ClearContents
    
    End If
    Next i


'---------------------Close Excel File-----------------

    Windows("Sort & Move Files.xlsm").Activate
    ActiveWindow.Close
    Application.DisplayAlerts = False


End Sub