求批量提取工作表另存

宋家老六

需求：
提取表格中的 工作量 经纬度 两张表格
将工作量表的公式转换为常规格式
在当前文件夹下新建 资管 文件夹
以工作量表A3单元格文字为文件名 并将其以2003格式保存至资管文件夹
在论坛找了很久没有找到相关的范例 请大师指点迷津

liulang0808

将工作量表的公式转换为常规格式
这句话没有看明白什么意思的，是要将公式转换成值？还是将公式所在单元格格式改成“常规”？

宋家老六

liulang0808 发表于 2018-9-17 15:15
将工作量表的公式转换为常规格式
这句话没有看明白什么意思的，是要将公式转换成值？还是将公式所在单元格 ...

就是转换为值。 系统不允许公式上传

liulang0808

宋家老六 发表于 2018-9-17 15:26
就是转换为值。 系统不允许公式上传

工作薄有保护，楼主看看吧

宋家老六

liulang0808 发表于 2018-9-17 15:33
工作薄有保护，楼主看看吧

版主，工作簿的解锁密码 92101
可是，我发下去填写的表格是必须要保护起来 以免有人改动格式。这个不影响工作表提取吗？

liulang0808

宋家老六 发表于 2018-9-17 15:46
版主，工作簿的解锁密码 92101
可是，我发下去填写的表格是必须要保护起来 以免有人改动格式。这个不影 ...

建议楼主保护工作表吧

xiangbaoan

'因审核，多发，删除，节省版面。

xiangbaoan

'还是因审核，多发，删除，节省版面。
浪费……………………………………………………

xiangbaoan

……审核，附件……

liulang0808

1. Sub 按钮20_Click()
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     pth = ThisWorkbook.Path & "\资管"
   
6.     arr = Array("工作量", "经纬度")
   
7.     If Not fso.folderexists(pth) Then
   
8.         MkDir pth
   
9.     End If
   
10.     For Each f In fso.getfolder(ThisWorkbook.Path).Files
    
11.         If InStr(f.Name, "批量处理宏代码") = 0 Then
    
12.             With Workbooks.Open(f)
    
13.                 .Unprotect "92101"
    
14.                 .Sheets(arr).Copy
    
15.                 With ActiveWorkbook
    
16.                     .Sheets("工作量").Unprotect
    
17.                     .Sheets("工作量").UsedRange.Value = .Sheets("工作量").UsedRange.Value
    
18.                     .SaveAs Filename:=pth & .Sheets("工作量").[a3] & ".xls", FileFormat:=xlExcel8
    
19.                     .Close False
    
20.                 End With
    
21.                 .Close False
    
22.             End With
    
23.         End If
    
24.     Next f
    
25. 
    
26.     Application.DisplayAlerts = True
    
27.     Application.ScreenUpdating = True
    
28. End Sub
    

复制代码