求助：如何不打开多个EXCEL文件提取数据存入指定EXCEL文件

terryzj · 发表于 2011-3-8 14:11

已解决
谢谢！

XUZHANCHENG · 发表于 2011-3-28 21:03

受益匪浅，有问题以后请教你

独立寒秋sina · 发表于 2012-9-4 22:30

zhaogang1960 发表于 2011-3-5 15:26
Sub Macro1()
Dim cnn As Object, SQL$, Mypath$, MyFile$, n%
Set cnn = CreateObject("adodb ...

我下了你的文件，可以用啊，不过我手头上的文件不是复制a1单元格的，是要复制E12,F12,G12,H12,I12这五个单元格的内容，该怎么修改呢？能否帮忙一下，非常感谢！

zhaogang1960 · 发表于 2012-9-4 22:33

请上传附件，模拟效果

zhaogang1960 · 发表于 2012-9-4 22:34

独立寒秋sina 发表于 2012-9-4 22:30
我下了你的文件，可以用啊，不过我手头上的文件不是复制a1单元格的，是要复制E12,F12,G12,H12,I12这五个单 ...

请上传附件，模拟效果

独立寒秋sina · 发表于 2012-9-4 23:11

zhaogang1960 发表于 2012-9-4 22:34
请上传附件，模拟效果

多谢回复。我的样本已上传，把其他四个文件夹中的E12-I12五个单元格的内容复制到操作表中。再次谢谢。

copydata.rar (15.61 KB, 下载次数: 17)

zhaogang1960 · 发表于 2012-9-4 23:43

独立寒秋sina 发表于 2012-9-4 23:11
多谢回复。我的样本已上传，把其他四个文件夹中的E12-I12五个单元格的内容复制到操作表中。再次谢谢。

...

文件名包含ADO不能识别的字符，不能使用ADO法
使用常规法吧：
Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, m&
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.csv")
Application.ScreenUpdating = False
[a1].CurrentRegion.Offset(1).ClearContents
m = 1
Do While MyName <> ""
      If MyName <> ThisWorkbook.Name Then
         m = m + 1
         With Workbooks.Open(MyPath & MyName)
            .Sheets(1).[e12:i12].Copy sh.Cells(m, 1)
            .Close False
         End With
      End If
      MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok"
End Sub

zhaogang1960 · 发表于 2012-9-4 23:44

请看附件

copydata.rar (28.16 KB, 下载次数: 66)

独立寒秋sina · 发表于 2012-9-5 22:34

zhaogang1960 发表于 2012-9-4 23:44
请看附件

非常感谢，可以用了！太牛了！

笨熊弟弟 · 发表于 2014-1-15 23:20

谢谢分享，留个脚印！

		自动登录	找回密码
密码			免费注册

[求助] 求助：如何不打开多个EXCEL文件提取数据存入指定EXCEL文件