提取各工作簿数据汇总的代码

excelnew1

提取各工作簿数据汇总的代码

excelnew1

顶下。。。。。。。

Yalishanda30

试试看行不行吧

liulang0808

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address(0, 0) <> "G1" Then Exit Sub
   
3.     If Len(Target.Value) = 0 Then Exit Sub
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     If fso.FolderExists(ThisWorkbook.Path & "" & Target.Value) Then
   
6.         Application.ScreenUpdating = False
   
7.         Application.EnableEvents = False
   
8.         
   
9.         Set ff = fso.getfolder(ThisWorkbook.Path & "" & Target.Value)
   
10.         a = 2
    
11.         Set sh = ActiveSheet
    
12.         For Each f In ff.Files
    
13.             With Workbooks.Open(f)
    
14.                 For Each sht In .Sheets
    
15.                     If sht.UsedRange.Cells.Count > 1 Then
    
16.                         sht.UsedRange.Copy sh.Cells(2, a)
    
17.                         a = a + 1
    
18.                         Exit For
    
19.                     End If
    
20.                 Next sht
    
21.                 .Close False
    
22.             End With
    
23.         Next f
    
24.         Application.EnableEvents = True
    
25.         Application.ScreenUpdating = True
    
26.     End If
    
27. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

excelnew1

Yalishanda30 发表于 2018-9-14 13:47
试试看行不行吧

好的。谢谢~。。。。

excelnew1

liulang0808 发表于 2018-9-14 14:32
附件内容供参考。。。。。。

谢谢版主老师~！很准确！

excelnew1

liulang0808 发表于 2018-9-14 14:32
附件内容供参考。。。。。。

你好老师如果改成不自动运行的。 也就是填入文件夹名后，再运行代码得到结果。代码如何改的？

excelnew1

Yalishanda30 发表于 2018-9-14 13:47
试试看行不行吧

存放的结果不一列中。也是按列放置。

liulang0808

excelnew1 发表于 2018-9-14 14:50
你好老师如果改成不自动运行的。 也就是填入文件夹名后，再运行代码得到结果。代码如何改的？

把事件名字换陈过一个普通名字，去除参数
代码中的target，部分微调即可