根据特定列生成不同的文件夹

langshufang

需求：根据我的文件中的B列生成母文件夹，嵌套C列生成子文件夹，之后根据D列生成不同的表。

已经实现的：现在的宏稍微修改，可以按照D列生成不同的表，但是我有3000多个表要生成，要保存在200多个文件夹下面，手动实在不现实。

所以求助大神啊。

xiangbaoan

把附件中的数据多写一点，少了，才2条，不愿写
3000多个文件是否都在D列放着?且前面对应着母文件夹和子文件夹?

langshufang

谢谢，收到，非常感谢~

langshufang

朱荣兴 发表于 2018-9-21 09:13
你的说明，跟你的代码实际生成的文件是有差别的，
Sub 拆分()
Application.ScreenUpdating = False '防止 ...

太感谢您了，还有很多需要学习的，我先试试这个

xiangbaoan

Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ar, r&, fso As Object, p$, p1$, p2$, f$, fil$
Set fso = CreateObject("scripting.filesystemobject")
p = ThisWorkbook.Path & "\"
f = p & "abcdefg.xlsx"
If Not fso.fileexists(f) Then
    With Workbooks.Add
        .SaveAs f, xlOpenXMLWorkbook
        .Close
    End With
End If
ar = [a1].CurrentRegion.Resize(, 4)
For r = 2 To UBound(ar)
    If Len(ar(r, 2)) Then
        p1 = p & ar(r, 2)
        If Not fso.folderexists(p1) Then
            fso.createfolder (p1)
            If Len(ar(r, 3)) Then
                p2 = p1 & "\" & ar(r, 3)
                If Not fso.folderexists(p2) Then
                    fso.createfolder (p2)
                    If Len(ar(r, 4)) Then
                        fil = p2 & "\" & ar(r, 4) & ".xlsx"
                        fso.copyfile f, fil, True
                    End If
                End If
            End If
        End If
    End If
Next
Set fso = Nothing
Kill f
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub