VBA that copy-paste a specific folder and name it as what the user was typing

[netanel99]

Hello all excel's Gurus and thank you so much for any sort of help.

I'm trying to write a code executed by commandbutton that will search a folder next to the file that called "projects and mega projects" and then search in the sub-folder a folder that called "template" and copy it and paste it there, giving it the name that the user has wrote , and then add a new row in the table and add a hyperlink in "click to view" that direct to this new folder created.

I've added pictures explaining what exactly I'm trying to achieve and I've added a code that does something else, but maybe it will help, this code is copy-paste a file called Template.xlsm, add a row, and hyperlink to this new file, it's a good code but it's not what I'm trying to achieve here, I'm trying to copy paste a folder.

THANK YOU SO MUCH FOR ANY HELP . !
I CANT BE GRATEFUL ENOUGH!

Option Explicit

Private Sub CommandButton1_Click()
Dim StrategyName As String, strategyRow As Long, NewName As String 'JBeaucaire made this code.

StrategyName = Application.InputBox("Enter the new product/service name", "New product/service Name", Type:=2)
If StrategyName = "False" Then Exit Sub
On Error Resume Next
strategyRow = WorksheetFunction.Match(StrategyName, ThisWorkbook.Sheets("Products & Services Contents").Range("B:B"), 0)
If strategyRow > 0 Then
    MsgBox "This product/service already exists"
    Exit Sub
End If

MkDir ThisWorkbook.Path & "\StrategiesAuto"
MkDir ThisWorkbook.Path & "\StrategiesAuto" & "\" & StrategyName
NewName = ThisWorkbook.Path & "\StrategiesAuto" & "\" & StrategyName & "\StrategyFromTemplate-" & StrategyName & ".xlsm"
FileCopy ThisWorkbook.Path & "\StrategyFromTemplate.xlsm", NewName
With ThisWorkbook.Sheets("Products & Services Contents").Range("B" & Rows.Count).End(xlUp).Offset(1)
    .Value = StrategyName
    ActiveSheet.Hyperlinks.Add _
        Anchor:=.Offset(, -1), _
        Address:=NewName, _
        TextToDisplay:="Link"
    Workbooks.Open NewName
    
End With

End Sub