Question

如何将一个文件夹中多个表格中的固定行列数值提取到一个新的EXCEL表格当中

我有相同格式的100多个excel文件，命名分别为001、002、003......现在需要提取每个excle中第一张工作表（命名为Natural Hazards）中的第 I 行的7-17列的数据到一个新的工作表中，使之依次为第A列、第B列......

求高手指导

Answer 1

以Excel2007操作为例：

1、首先打开Excel，如图所示，接着在汇总表中找到需要汇总种类的第一个单元格。

2、然后单击选中的单元格，然后在编辑栏输入“=sum（公司1!”。

3、接着需要汇总的新单元格中，如图所示，此时单元格边框变成虚线状态。

4、然后按住shift键后选中需要汇总的表的最后一张。

5、最后，再返回到刚才编辑框中加上“）”，将公式补全后按回车，这样就可以汇总完成，这样操作就可以解决问题。

Answer 2

使用VBA（宏）代码，按Alt+F11进入VBA界面，按Alt+i+m插入模块后，复制以下代码，按F5执行

Sub copyall()
Dim n%
n=1
For i = 1 To 5 '把这个数字改成你的文件总数
    Set excel_Book = Workbooks.Open("E:\excel\00" & i & ".xlsx") '地址写作"E:\xxx\xxx\"保留英文双引号
    Set excel_Sheet = excel_Book.Worksheets("Natural Hazards")
    excel_Sheet.Range("I7:I17").Copy ThisWorkbook.Worksheets("Sheet1").Cells(1,n)
    n=n+1
    excel_Book.Close False
Next
Set excel_Sheet = Nothing
Set excel_Book = Nothing
End Sub

追问

请问高手这个怎么解决

追答

你看看你的文件是xls格式还是xlsx格式，可能是后缀名不对。是xls的话，把代码改一下看看

追问

我所取的这一列的值是通过公式得出的，现在调用过来成了这个样子

追答

唔。是公式的话我改改。你等等哈

追问

高手，万分感谢，可加qq吗，我还有几个这方面的问题，不好意思了，付费也可以的，拜托

追答

私信说。

Sub copyall()
Dim n%
n=1
For i = 1 To 5 '把这个数字改成你的文件总数
    Set excel_Book = Workbooks.Open("E:\excel\00" & i & ".xlsx") '地址写作"E:\xxx\xxx\"保留英文双引号
    Set excel_Sheet = excel_Book.Worksheets("Natural Hazards")
    excel_Sheet.Range("I7:I17").Copy
    ThisWorkbook.Worksheets("Sheet1").Cells(1,n).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    n=n+1
    excel_Book.Close False
Next
Set excel_Sheet = Nothing
Set excel_Book = Nothing
End Sub

Answer 3

Sub CommandButton1_Click() Filename = Application.GetOpenFilename(FileFilter:="Excel ,*.xls*", Title:="Choose Files", MultiSelect:=True)'可使用Ctrl或Shift选择多个文件 If Not IsArray(Filename) Then Exit Sub Application.ScreenUpdating = False For i = 1 To UBound(Filename) Set xlbook = Workbooks.Open(Filename(i)) 'sheet1中的B7,sheet2中的C5,sheet3中的D6 Cells(i, "A") = xlbook.Sheets("sheet1").[B7] Cells(i, "B") = xlbook.Sheets("sheet2").[C5] Cells(i, "C") = xlbook.Sheets("sheet3").[D6] xlbook.Close Next i Application.ScreenUpdating = TrueEnd Sub