准提部林

回復 10# ziv976688


Sub 新增檔案()
Dim S, P$, T$, xB As Workbook, N%
P = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each S In Array("均值", "尾數", "合數", "生肖", "五行", "八卦")
    T = Dir(P & "今日總表(" & S & "排序)-*_*-(????-??-??).xls")
    If T = "" Then GoTo 101
    T = Left(T, 11) & Left(Right(T, 16), 12) & "_統計.xls"
    Sheets("統計").Copy
    With ActiveWorkbook: .SaveAs Filename:=P & T, CreateBackup:=False: .Close: End With
    N = N + 1
101: Next
If N > 0 Then MsgBox "共建立 " & N & " 個新檔案!  "
End Sub

ziv976688

回復 11# 准提部林

版主:您好!
感謝解題。
測試OK如需求。
您太厲害了，竟能任選1個或2個或...或全選 ，
這樣我就不用作6個主檔了。
謝謝您的耐心指導~感恩^^

zheng211016

回復 8# ziv976688

我在拆字的部分 設定錯誤 所以偵錯會出現另存檔案失敗
幸好有版大 出手幫忙
那我就協助 註解的部分

下載 (65.99 KB)

2019-4-15 21:47

ziv976688

回復 13# zheng211016
zheng211016大大:您好!
您太謙虛了^^
謝謝您的詳細註解，使我更瞭解程式碼的意涵。