修改代码

ykcbf1100

原代码上小改一下。

1. Sub 导出()
   
2.     Dim Items, strPath$, wkb As Workbook, sht As Worksheet
   
3.     strPath = ThisWorkbook.Path & ""
   
4.     With Application.FileDialog(1)
   
5.         With .Filters
   
6.             .Clear
   
7.             .Add "Excel Files", "*.xls*"
   
8.         End With
   
9.         .AllowMultiSelect = False
   
10.         .InitialFileName = strPath
    
11.         If .Show Then Set Items = .SelectedItems Else Exit Sub
    
12.     End With
    
13.     Application.ScreenUpdating = False
    
14.     Set ws = ThisWorkbook
    
15.     fn = Array("凭证号", "汇总", "1", "2", "3")
    
16.     Set wkb = Workbooks.Open(Items(1), 0)
    
17.     For x = 0 To UBound(fn)
    
18.         ws.Sheets(fn(x)).Copy after:=wkb.Sheets(wkb.Sheets.Count)
    
19.     Next
    
20.     wkb.Close 1
    
21.     Set wkb = Nothing
    
22.     Application.ScreenUpdating = True
    
23.     Beep
    
24. End Sub
    

复制代码

ddz79101

ykcbf1100 发表于 2024-6-22 20:46
小改一下。

谢谢老师！成功运行