关于vba表格复制出错的问题

asd1220

设置的代码如下

1. Sub Sum_up()
   
2. Dim bt As Range, r As Long, c As Long
   
3. r = 1 '定义行数
   
4. c = 7 '定义列数
   
5. Dim rt As Worksheet
   
6. Set rt = ThisWorkbook.Worksheets(1) '将汇总表的赋予变量rt
   
7. rt.Rows(r + 1 & ":1048576").ClearContents '清空数据只保留表头
   
8. Application.ScreenUpdating = False
   
9. Dim rfilename As String, rsht As Worksheet, rwb As Workbook
   
10. Dim rrow As Long, rfn As String, rarr As Variant
    
11. rfilename = Dir(ThisWorkbook.Path & "\*.xls")
    
12. Do While rfilename <> ""
    
13. If rfilename <> "报名填写" Then
    
14. rrow = rt.Range("B8").CurrentRegion.Rows.Count + 1 '获取数据
    
15. rfn = ThisWorkbook.Path & "" & rfilename
    
16. Set rwb = GetObject(rfn)
    
17. Set rsht = rwb.Worksheets(1)
    
18. rarr = rsht.Range(rsht.Cells(r + 1, "A"), rsht.Cells(1048576, "B").End(xlUp).Offset(0, 6))
    
19. rwt.Cells(rrow, "A").Resize(UBound(rarr, 1), UBound(rarr, 2)) = rarr
    
20. rwb.Close False
    
21. End If
    
22. rfilename = Dir
    
23. Loop
    
24. Application.ScreenUpdating = True
    
25. End Sub

复制代码

然后运行时报错提示需要对象
程序断在

1. rwt.Cells(rrow, "A").Resize(UBound(rarr, 1), UBound(rarr, 2)) = rarr

复制代码

求助怎么修改啊

相关文件也都在同一个文件夹里面

我想实现的功能是把工作簿.xls里面拷贝数据
范围B列到G列，从第8行开始，拷贝所有有效信息

新建文件夹.rar (19.68 KB, 下载次数: 4)

2018-4-8 11:01 上传

点击文件名下载附件

abc123281

你想要干什么  说明白  说清楚

asd1220

abc123281 发表于 2018-4-8 11:14
你想要干什么  说明白  说清楚

感谢您的关注

我想实现的功能是把工作簿.xls里面拷贝数据
范围B列到G列，从第8行开始，拷贝所有有效信息

abc123281

像工作簿.xls这样的表才有一个吗

abc123281

仅供参考

1. Sub 汇总数据()
   
2. Dim wb As Workbook
   
3. Dim lastcell As Range
   
4. Dim brr(1 To 1000, 1 To 6)
   
5. Dim mypath$, myname$
   
6. Application.DisplayAlerts = False
   
7. Application.ScreenUpdating = False
   
8. mypath = ThisWorkbook.Path & ""
   
9. myname = Dir(mypath & "*.xl*")
   
10. Do While myname <> ""
    
11.     If myname <> ThisWorkbook.Name Then
    
12.         Set wb = GetObject(mypath & myname)
    
13.         With wb
    
14.             With .Worksheets(1)
    
15.                rw = .[b65536].End(xlUp).Row
    
16.                arr = .Range("b8:g" & rw)
    
17.                For i = 1 To UBound(arr)
    
18.                  n = n + 1
    
19.                  For j = 1 To 6
    
20.                     brr(n, j) = arr(i, j)
    
21.                  Next
    
22.                Next
    
23.             End With
    
24.            wb.Close False
    
25.          End With
    
26.      End If
    
27.     myname = Dir()
    
28. Loop
    
29. With ThisWorkbook.Worksheets("汇总")
    
30.   Set lastcell = .[c65536].End(xlUp).Offset(1, 0)
    
31.   lastcell.Resize(n, 6) = brr
    
32. End With
    
33. Application.DisplayAlerts = True
    
34. Application.ScreenUpdating = True
    
35. MsgBox "OK  数据汇总完成！"
    
36. End Sub
    

复制代码

abc123281

复制abc123.rar (25.28 KB, 下载次数: 4)

2018-4-8 15:25 上传

点击文件名下载附件

asd1220

abc123281 发表于 2018-4-8 15:24
仅供参考

感谢老师指导！

asd1220

abc123281 发表于 2018-4-8 15:25

老师您好，很惭愧再次向您求助
写了好几次都不知道如何将工作簿中的队名数据同之前统计的数据一并汇总到一起
也就是说拷贝工作簿.xls的数据
范围B列到G列，从第8行开始，拷贝所有有效信息，并将队名数据[b2]汇总到一起

abc123281

你的要求不明白

asd1220

abc123281 发表于 2018-4-23 11:58
你的要求不明白

首先感谢老师回复，我截图描述一下
表1

表2


按照之前您给的代码，我已经成功的做到了汇总姓名到项目的功能，但是原本自己想类比您的写法把队名信息也也写入，但是却屡屡报错
也就是做到这种效果

还请老师赐教