[已解决]不打开EXCEL，批量读取EXCEL指定内容。

010203400

请教一下，如截图和附件，有几个档案，现在要在Temp0中写宏，

当执行时，可以在不打开另外8个档案的情况下，读取另外8个档案中的ABCD栏位的所有内容（不包含第1行），和这8个档案的文件名，

将ABCD栏位的所有内容（不包含第1行）全部放在Temp0中的ABCD栏，并在E栏填入和对应档案的档案名。

拜托各位了。

最佳答案

月排行榜 / 总排行榜

dsmch

2016-5-30 15:14

1. Sub Macro1()
   
2. Set sht = ThisWorkbook.Sheets(1)
   
3. mypath = ThisWorkbook.Path & ""
   
4. wj = Dir(mypath & "*.xls")
   
5. Application.ScreenUpdating = False
   
6. [a2:e60000].Clear
   
7. Do While wj <> ""
   
8.     If wj <> ThisWorkbook.Name Then
   
9.         n = sht.Range("a65536").End(xlUp).Row + 1
   
10.         zf = Split(wj, ".xls")(0)
    
11.         With GetObject(mypath & wj)
    
12.             Set rng = .Sheets(1).Range("a1").CurrentRegion.Offset(1, 0)
    
13.             rng.Copy sht.Cells(n, 1)
    
14.             sht.Cells(n, 5).Resize(rng.Rows.Count - 1) = zf
    
15.             .Close 0
    
16.         End With
    
17.     End If
    
18.     wj = Dir
    
19. Loop
    
20. Application.ScreenUpdating = True
    
21. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Set sht = ThisWorkbook.Sheets(1)
   
3. mypath = ThisWorkbook.Path & ""
   
4. wj = Dir(mypath & "*.xls")
   
5. Application.ScreenUpdating = False
   
6. [a2:e60000].Clear
   
7. Do While wj <> ""
   
8.     If wj <> ThisWorkbook.Name Then
   
9.         n = sht.Range("a65536").End(xlUp).Row + 1
   
10.         zf = Split(wj, ".xls")(0)
    
11.         With GetObject(mypath & wj)
    
12.             Set rng = .Sheets(1).Range("a1").CurrentRegion.Offset(1, 0)
    
13.             rng.Copy sht.Cells(n, 1)
    
14.             sht.Cells(n, 5).Resize(rng.Rows.Count - 1) = zf
    
15.             .Close 0
    
16.         End With
    
17.     End If
    
18.     wj = Dir
    
19. Loop
    
20. Application.ScreenUpdating = True
    
21. End Sub

复制代码

010203400

dsmch 发表于 2016-5-30 15:14

你好，請教一下，
Set sht = ThisWorkbook.Sheets(1)
這里的Sheets(1)是那8個檔案中的Sheets(1)，還是要彙總的檔案中的Sheets(1)啊？

010203400

010203400 发表于 2016-5-30 16:18
你好，請教一下，
Set sht = ThisWorkbook.Sheets(1)
這里的Sheets(1)是那8個檔案中的Sheets(1)，還是要 ...

你好，再問一下，哪個地方是改變要copy檔案中的內容範圍呢，我現在想改為copy 6欄。