新建文件夹并将任意两个月的表格复制到该文件夹里

革力

        各位老师，见附件，我现在有一个  “年度汇总 ” 文件夹，里面有若干月份的Excel工作簿，
    1.我需要新建若干新文件夹，将任意两个月的工作簿Excel放在该文件夹里，并将文件夹   按月份命名 ，如1-2汇总，1-3汇总等

       2.并且将工作簿“汇总”复制到相应的的文件夹里，名字改为和文件夹同名

谢谢

liulang0808

https://club.excelhome.net/thread-1258425-1-1.html
这个链接内容，楼主可以参考下

limonet

关键字：￥￥￥￥-replace -split

limonet

Sub limonet()
    Dim i%, j%, Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    For i = 1 To 4
        For j = 1 To 4
            If j <> i And Not Dic.exists(j & "-" & i) And Not Dic.exists(i & "-" & j) Then Dic(j & "-" & i) = ""
        Next j
    Next i
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & ";$a='" & Join(Dic.keys, "汇总','") & "汇总';md $a;foreach ($i in $a) { copy (dir .\* -Include" _
    & " (($i -replace '(\d)-(\d).*','$1*￥$2*') -split '￥')) $i;copy 汇总.xlsm ($i,'\',$i,'.xlsm' -join '')}", 0
End Sub

ykcbf1100

练手，建立任意二月的子目录、复制月份文件进对应子目录、把汇总文件复制进每个子目录中，并把汇总文件名改为与子目录同名

ykcbf1100

练习。。。。。

1. Sub ykcbf()   '//2024.6.14,按要求归类月份文件
   
2.     '//**************************************************
   
3.     '// 说明:
   
4.     '//        1、自动建立任意二月的对应子目录
   
5.     '//        2、把月份文件复制到对应的子目录中
   
6.     '//        3、把汇总文件复制进对应子目录中,并把文件名改为与子目录同名
   
7.     '//******************************************************
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     Set fso = CreateObject("scripting.filesystemobject")
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     p = ThisWorkbook.Path & ""
    
13.     For Each f In fso.GetFolder(p).Files
    
14.         fn = fso.GetBaseName(f)
    
15.         If Val(fn) Then
    
16.             s = Replace(Split(fn, "-")(0), "月", "")
    
17.             d(s) = ""
    
18.         End If
    
19.     Next f
    
20.     For x = 1 To d.Count - 1
    
21.         For y = 2 To d.Count
    
22.             If x < y Then
    
23.                 fd = x & "-" & y & "汇总"
    
24.                 p1 = p & fd
    
25.                 If Not fso.FolderExists(p1) Then fso.CreateFolder p1
    
26.                 For Each f In fso.GetFolder(p).Files
    
27.                     fn = fso.GetBaseName(f)
    
28.                     If x = Val(fn) Or y = Val(fn) Then
    
29.                         fso.CopyFile f, p1
    
30.                     End If
    
31.                 Next f
    
32.                 f1 = p & "汇总.xlsm"
    
33.                 fso.CopyFile f1, p1
    
34.                 For Each f In fso.GetFolder(p1).Files
    
35.                     fn = fso.GetBaseName(f)
    
36.                     If fn = "汇总" Then f.Name = Replace(fd, "", ".xlsm")
    
37.                 Next
    
38.             End If
    
39.         Next
    
40.     Next
    
41.     Application.ScreenUpdating = True
    
42.     MsgBox "OK！"
    
43. End Sub
    
44. 
    

复制代码