Создание новой папки, когда выбрана ячейка с ее именем

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    '// Проверяем, что выделенная ячейка пересеклась с колонкой "А"
    If Not Intersect(Target, Columns("A")) Is Nothing Then
        '//Проверяем, что это не первая строка (там у нас будет заголовок таблицы)
        If Target.Row <> 1 Then
            '// Проверяем, что ячейка не пуста
            If Len(Target.Value) <> 0 Then
                '// На всякий случай - предотвращение ошибок во время файловых операций
                On Error Resume Next
                '// Внимание Mkdir (в отличие от DOS-версии) не умеет создавать цепочку папок
                '// Это означает, что папка, в которой нужно создавать новую, уже должна существовать
                Dim HomeDir$
                HomeDir = "c:\users\alex\desktop\test" '// Задаем исходную папку (у Вас - это: "D:\Base")
                MkDir (HomeDir & "\" & Target.Value)
                On Error GoTo 0
            End If
        End If
    End If
End Sub

        '//Проверяем, что это не первая строка (там у нас будет заголовок таблицы)
        If Target.Row <> 1 Then

 If Target.Row > 6   Then

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    '// Проверяем, что выделенная ячейка пересеклась с колонкой "А"
    If Not Intersect(Target, Columns("B")) Is Nothing Then
        '//Проверяем, что это не первая строка (там у нас будет заголовок таблицы)
        If Target.Row <> 1 Then
            '// Проверяем, что ячейка не пуста
            If Len(Target.offset(0,-1).Value) <> 0 Then
                '// На всякий случай - предотвращение ошибок во время файловых операций
                On Error Resume Next
                '// Внимание Mkdir (в отличие от DOS-версии) не умеет создавать цепочку папок
                '// Это означает, что папка, в которой нужно создавать новую, уже должна существовать
                Dim HomeDir$
                HomeDir = "c:\users\alex\desktop\test" '// Задаем исходную папку (у Вас - это: "D:\Base")
                MkDir (HomeDir & "\" & Target.offset(0,-1).Value)
                On Error GoTo 0
            End If
        End If
    End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    '// Проверяем, что выделенная ячейка пересеклась с колонкой "А"
    If Not Intersect(Target, Columns("B")) Is Nothing Then
        '//Проверяем, что это не первая строка (там у нас будет заголовок таблицы)
        If Target.Row <> 1 Then
            If Target.Cells.Count = 1 Then '// Если выделена только одна ячейка
                '// Проверяем, что ячейка не пуста
                If Len(Target.Offset(0, -1).Value) <> 0 Then
                    '// На всякий случай - предотвращение ошибок во время файловых операций
                    On Error Resume Next
                    '// Внимание Mkdir (в отличие от DOS-версии) не умеет создавать цепочку папок
                    '// Это означает, что папка, в которой нужно создавать новую, уже должна существовать
                    Dim HomeDir$
                    HomeDir = "c:\users\alex\desktop" '// Задаем исходную папку (у Вас - это: "D:\Base")
                    MkDir (HomeDir & "\" & Target.Offset(0, -1).Value)
                    If Err = 0 Then Cells(Target.Row, "C").Formula = "=HYPERLINK(""" & HomeDir & "\""&A" & Target.Row & ","">>>"")"
                End If
            End If
        End If
    End If
End Sub

If Not Intersect(Target, Columns("B")) Is Nothing and target.Parent.name = "База" Then

If Not Intersect(Target, Columns("B")) Is Nothing and sh.name = "База" Then

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub