VBA提取当前文件夹内所有工作表内指定的单元

pizza5

请问大大，要如何编写一段VBA代码，以实现以下的功能：
1. 文件夹内有接近一百个xlsx文档
2. 每个文档内有数个worksheet，数量不一，需要提取每个文档的档名，放在新建文档的A1，提取第一个worksheet的名称，放在新建文档的B1,第二个worksheet名放B2；第二个文档名放A3，里面的第一个worksheet名放B3，第二个worksheet名放B4，余此类推
3. 每个worksheet内需要提取的单元是固定的，例如：E4,D4,D5,D6,D7,D10,C13,C17...这个过后可以增加或删减
4. 提取的单元值按照次序植入B1,C1,D1...

请各位大大帮忙，在此先谢谢大家了

pizza5

朱荣兴 发表于 2016-7-15 09:35
1、请上传excel附件，
2、楼主的描述好像有些混乱，请认真核实

大大你好，附件已上传，描述不清晰，请见谅
简单来说，是要从许多工作簿，许多工作表内，按照次序，提取每一个工作表内，指定单元的内容，把内容按次序，放在新建的工作表内
我爬了许多文，也下载了几个实例，但都不能直接套用，主要原因是工作表的名称没规律（这个你看附件就知道了）

pizza5

稍微顶一下，请大大们帮忙

131409166

遍历文件夹里所有的文件

舍乐

看符合你的要求吗？想提取什么单元格，可以在第一行随意删减。隐藏的工作表默认跳过，不读取数据。

opiona

1. Sub Opiona() '//函数实例
   
2. 
   
3.     Set SH0 = Worksheets("Sheet1")
   
4.     SH0.Range("A1:L1048576").ClearContents
   
5.    
   
6.     ARX = Split("E4,D4,D5,D6,D7,D10,C13,C17,F19,F21", ",")
   
7.     IROW = 1
   
8.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
   
9.     For I = 0 To UBound(FileArr)
   
10.         Set WB = Workbooks.Open(FileArr(I))
    
11.         For Each SH In WB.Worksheets
    
12.             If SH.Visible = -1 Then  '//隐藏的工作表默认跳过
    
13.                 SH0.Cells(IROW, 1) = GetPathFromFileName(FileArr(I))
    
14.                 SH0.Cells(IROW, 2) = SH.Name
    
15.                 For X = 0 To UBound(ARX)
    
16.                     SH0.Cells(IROW, X + 3) = SH.Range(ARX(X)).Value
    
17.                 Next
    
18.                 IROW = IROW + 1
    
19.             End If
    
20.         Next
    
21.         
    
22.         WB.Close False
    
23.     Next
    
24. 
    
25. End Sub

复制代码

opiona

100.rar (233.05 KB, 下载次数: 123)

2016-7-15 21:15 上传

点击文件名下载附件

pizza5

舍乐 发表于 2016-7-15 17:34
看符合你的要求吗？想提取什么单元格，可以在第一行随意删减。隐藏的工作表默认跳过，不读取数据。

谢谢大大，我先试试看

pizza5

舍乐 发表于 2016-7-15 17:34
看符合你的要求吗？想提取什么单元格，可以在第一行随意删减。隐藏的工作表默认跳过，不读取数据。

谢谢大大，我先试试看，回头再来汇报