Macro saving all sheets in a new file * in different folders * depending on conditions

Hi everybody,
I'm actually using a macro that saves all the sheets from a workbook in new separate files, and save them in a specified folder.
----

Code:

---

Sub Estrazione_Schede()

Dim n As Long
Dim myNome As String
Dim myPath As String
myPath = "D:\path"

With ActiveWorkbook
    For n = 4 To .Sheets.Count   
        myNome = .Sheets(n).Name     
                  .Sheets(n).Copy
            ActiveWorkbook.SaveAs Filename:=myPath & myNome
            ActiveWorkbook.Close
        Next n             
End With
End Sub

---

----
what I'm trying to do is that, instead of saving all the sheets in one folder, the macro would save them in different folders, depending on specific values in a specific cell of each sheet. I tried to modify the macro like this, but it doesn't seem to work properly:
----

Code:

---

Sub Estrazione_Schede()

Dim n As Long
Dim myNome As String
Dim myPathOne As String
Dim myPathTwo As String

myPathOne = "D:\pathOne\"
myPathTwo = "D:\pathTwo\"

With ActiveWorkbook
    For n = 4 To .Sheets.Count
       
        myNome = .Sheets(n).Name
             
        If ActiveSheet.Range("B2").Text <> "" Then
        If ActiveSheet.Range("B2").Text = "One" Then
            .Sheets(n).Copy
   
            ActiveWorkbook.SaveAs Filename:= myPathOne & myNome
            ActiveWorkbook.Close
       
        If ActiveSheet.Range("B2").Text = "Two" Then
            .Sheets(n).Copy
   
            ActiveWorkbook.SaveAs Filename:= myPathTwo & myNome
            ActiveWorkbook.Close
       
        End If
        End If
        End If
       
        Next n
               
End With
End Sub

---

------
with this code the macro ends up to check the condition only in the first sheet and then it copies all the sheet in the same folder.

Do you have any suggestion on where I'm wrong?:confused:
thanks a lot:)

Moderator's Edit: I have put code tags for you. To do so in future, select the code and click on the # icon above.