请老师帮助，导出sheet表

zk40

请老师帮助，导出sheet表，具体说明在EXCEL文件中

3190496160

Sub 拷贝()
Application.ScreenUpdating = False
lj = ThisWorkbook.Path & "\备份\"
sl = Len(ThisWorkbook.Name)
mc = Mid(ThisWorkbook.Name, 6, sl - 9) & "报表"
For Each sh In Sheets(Array("上海", "江苏", "广东", "浙江", "四川"))
    m = m + 1
    If m = 1 Then
        sh.Copy
        Set wb = ActiveWorkbook
    Else
        sh.Copy after:=wb.Sheets(wb.Sheets.Count)
    End If
Next sh
wb.SaveAs Filename:=lj & mc & ".xlsx"
wb.Close
f = Dir(ThisWorkbook.Path & "\*.doc*")
Do While f <> ""
    If InStr(f, "公司") > 0 Then
        FileCopy ThisWorkbook.Path & "\" & f, lj & f
    End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

新建文件夹 (2).rar (37.98 KB, 下载次数: 7)

2024-6-18 08:40 上传

点击文件名下载附件