[已解决]历遍工作表移动数据的问题

Dengbb

附件 历遍工作表移动数据附件.rar (283.85 KB, 下载次数: 16)

2013-6-24 13:07 上传

点击文件名下载附件
先谢谢各位老师了。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-24 13:28

1. Sub test()
   
2. 
   
3.     On Error GoTo ErrorHandler
   
4.     With Application
   
5.         .ScreenUpdating = False
   
6.         .DisplayAlerts = False
   
7.         .EnableEvents = False
   
8.         .Calculation = xlCalculationManual
   
9.     End With
   
10.    
    
11.     Dim arr
    
12.     Dim bSheet As Byte
    
13.     For bSheet = 1 To 6
    
14.         With Worksheets(CStr(bSheet))
    
15.             arr = .Range("a1").CurrentRegion.Columns("a:f").Value
    
16.         End With
    
17.         With Worksheets("sheet0")
    
18.             With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
19.                 .Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
20.             End With
    
21.         End With
    
22.     Next
    
23. 
    
24.     With Application
    
25.         .ScreenUpdating = True
    
26.         .DisplayAlerts = True
    
27.         .EnableEvents = True
    
28.         .Calculation = xlCalculationAutomatic
    
29.     End With
    
30.     MsgBox "合并完成"
    
31.     Exit Sub
    
32.    
    
33. ErrorHandler:
    
34.     MsgBox Err.Number & vbCrLf & _
    
35.            Err.Description
    
36.     With Application
    
37.         .ScreenUpdating = True
    
38.         .DisplayAlerts = True
    
39.         .EnableEvents = True
    
40.         .Calculation = xlCalculationAutomatic
    
41.     End With
    
42. 
    
43. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

是移动到行下面了，还是列的右边。

hwc2ycy

你说的是移动吧，数据过来后，原有工作表里的数据清除掉，对不？

hwc2ycy

1. Sub test()
   
2. 
   
3.     On Error GoTo ErrorHandler
   
4.     With Application
   
5.         .ScreenUpdating = False
   
6.         .DisplayAlerts = False
   
7.         .EnableEvents = False
   
8.         .Calculation = xlCalculationManual
   
9.     End With
   
10.    
    
11.     Dim arr
    
12.     Dim bSheet As Byte
    
13.     For bSheet = 1 To 6
    
14.         With Worksheets(CStr(bSheet))
    
15.             arr = .Range("a1").CurrentRegion.Columns("a:f").Value
    
16.         End With
    
17.         With Worksheets("sheet0")
    
18.             With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
19.                 .Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
20.             End With
    
21.         End With
    
22.     Next
    
23. 
    
24.     With Application
    
25.         .ScreenUpdating = True
    
26.         .DisplayAlerts = True
    
27.         .EnableEvents = True
    
28.         .Calculation = xlCalculationAutomatic
    
29.     End With
    
30.     MsgBox "合并完成"
    
31.     Exit Sub
    
32.    
    
33. ErrorHandler:
    
34.     MsgBox Err.Number & vbCrLf & _
    
35.            Err.Description
    
36.     With Application
    
37.         .ScreenUpdating = True
    
38.         .DisplayAlerts = True
    
39.         .EnableEvents = True
    
40.         .Calculation = xlCalculationAutomatic
    
41.     End With
    
42. 
    
43. End Sub

复制代码

hwc2ycy

原有工作表1-6的内容没有清除。

Dengbb

hwc2ycy 发表于 2013-6-24 13:30
原有工作表1-6的内容没有清除。

谢谢老师帮助，试了一下，效果很好。再谢。