VBA 分文件夹 分excel

Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Sub chaifen()

Dim i
Dim j
i = 2
j = 4

'当前excel路径下,创建功能点、问题类2个文件夹
Path = ThisWorkbook.Path & "\功能点"
Path1 = ThisWorkbook.Path & "\问题类"
MkDir Path
MkDir Path1

Do While j < 100  '列小于100

    dirsub =Cells（1,j）'每个流程的目录名

    Set yyy = CreateObject("Scripting.FileSystemObject")
    If yyy.FolderExists(Path +"\"+ dirsub ) <> True Then
     MkDir Path +"\"+ dirsub
    end if

    If yyy.FolderExists(Path1 +"\"+ dirsub ) <> True Then
     MkDir Path1 +"\"+ dirsub
    end if

    Do While i <  ActiveSheet.UsedRange.Rows.Count+1   '行限制
 '取出单元格内容
        SearchNumber = Cells(i, j)
        If SearchNumber <> "" Then
  ' copy一个文件,此处生成2个excel文档。
           
            CopyFile "功能点模板", Path +"\"+ dirsub +"\" + Cells(1, j) + "_" + Cells(i, 3) + SearchNumber + "（功能点）.xlsx", 1

            CopyFile "问题类模板", Path1+"\"+ dirsub  +"\" + Cells(1, j) + "_" + Cells(i, 3) + SearchNumber + "（问题类文档）.xlsx", 1
           

        End If
       i = i + 1
    Loop
    j = j + 1
    i = 2
   
Loop

End Sub