Sub フォルダ作成()
　　Dim i As Long
　　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
　　　　MkDir ThisWorkbook.Path & "\" & Cells(i, 1)
　　Next i
End Sub
からの
Sub フォルダ作成()
Dim i As Long
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
MkDir "D:\articles" & Cells(i, 1)
Next i
End Sub