请老师们帮我看看，为什么不能取数呢？我把代码表和取数表都发上来了。

萧瑟处

Sub 社保汇总()
    Dim filter As String, k As String
    Dim filetoopen, arr, brr
    Dim i As Integer
    Dim wk As Workbook
    Dim maxrow As Long
    Dim rng As Range
    Dim sht As Worksheet
    Application.DisplayAlerts = False
    filter = "all files(*.*),*.*,word documents(*.do*),*.do*,text files(*.txt),*.txt,excel files(*.xl*),*.xl*"
    filetoopen = Application.GetOpenFilename(filter, 4, "请选择文件", , True)
    Set sht = ActiveSheet
    sht.Cells.Clear '删除旧数据
    sht.Columns(3).NumberFormatLocal = "@"
    If IsArray(filetoopen) = False Then
       MsgBox "你没有选择文件"
    Else
       For i = 1 To UBound(filetoopen)
           Set wk = Workbooks.Open(filetoopen(i))
           Sheet1.Select
           maxrow = Sheet1.Range("E65536").End(xlUp).Row
           arr = Sheet1.Range("b2:R" & maxrow)
           brr = Sheet1.Range("a1:R1")
           wk.Close False
           sht.Range("b" & sht.Range("b65536").End(xlUp).Row + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
           sht.Range("a1：R1") = brr
       Next i
    End If


    For i = 2 To sht.Range("B65536").End(xlUp).Row
        sht.Cells(i, 1) = i - 1
    Next

    k = Range("k2") & "医疗汇总"
        sht.Name = k
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & k
End Sub

feilanga

1. Sub 社保汇总()
   
2.     Dim filter As String, k As String
   
3.     Dim filetoopen, arr, brr
   
4.     Dim i As Integer
   
5.     Dim wk As Workbook
   
6.     Dim maxrow As Long
   
7.     Dim rng As Range
   
8.     Dim sht As Worksheet
   
9.     Application.DisplayAlerts = False
   
10.     filter = "all files(*.*),*.*,word documents(*.do*),*.do*,text files(*.txt),*.txt,excel files(*.xl*),*.xl*"
    
11.     filetoopen = Application.GetOpenFilename(filter, 4, "请选择文件", , True)
    
12.     Set sht = ActiveSheet
    
13.     sht.Cells.Clear '删除旧数据
    
14.     sht.Columns(3).NumberFormatLocal = "@"
    
15.     If IsArray(filetoopen) = False Then
    
16.         MsgBox "你没有选择文件"
    
17.     Else
    
18.         For i = 1 To UBound(filetoopen)
    
19.             Set wk = Workbooks.Open(filetoopen(i))
    
20.             maxrow = wk.Sheets("医保").Range("E65536").End(xlUp).Row
    
21.             arr = wk.Sheets("医保").Range("b2:R" & maxrow)
    
22.             brr = wk.Sheets("医保").Range("a1:R1")
    
23.             wk.Close False
    
24.             sht.Range("b" & sht.Range("b65536").End(xlUp).Row + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
    
25.             sht.Range("a1：R1") = brr
    
26.         Next i
    
27.     End If
    
28.     For i = 2 To sht.Range("B65536").End(xlUp).Row
    
29.         sht.Cells(i, 1) = i - 1
    
30.     Next
    
31.     k = Range("k2") & "医疗汇总"
    
32.     sht.Name = k
    
33.     ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & k
    
34. End Sub

复制代码

跨工作簿不能使用sheet1

萧瑟处

明白了。谢谢！