[已解决]求助简化代码

fghji

sub 总数()
   Sheets("1").Select
   Application.DisplayAlerts = False
   With Workbooks.Open(ThisWorkbook.Path & "\book1.xls")
   Workbooks("book1.xls").Sheets(6).Range("A2:E95").Copy Workbooks("book50.xls").Sheets(1).Range("AL3")
    .Close True
    End With
   With Workbooks.Open(ThisWorkbook.Path & "\book2.xls")
   Workbooks("book2.xls").Sheets(6).Range("A2:E95").Copy Workbooks("book50.xls").Sheets(1).Range("AL100")
    .Close True
    End With
   With Workbooks.Open(ThisWorkbook.Path & "\book3.xls")
   Workbooks("book3.xls").Sheets(6).Range("A2:E95").Copy Workbooks("book50.xls").Sheets(1).Range("AL200")
    .Close True
    End With
   With Workbooks.Open(ThisWorkbook.Path & "\book4.xls")
   Workbooks("book4.xls").Sheets(6).Range("A2:E95").Copy Workbooks("book50.xls").Sheets(1).Range("AL300")
    .Close True
    End With
   With Workbooks.Open(ThisWorkbook.Path & "\book5.xls")
   Workbooks("book5.xls").Sheets(6).Range("A2:E95").Copy Workbooks("book50.xls").Sheets(1).Range("AL400")
    .Close True
    End With
    Application.DisplayAlerts = True
End sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-17 14:14

数组搞错了。

1. Sub 总数()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlCalculationManual
   
5.     Application.EnableEvents = False
   
6.    
   
7.     Dim arr
   
8.     Dim arrPos
   
9.     Dim i As Byte
   
10.    
    
11.     ThisWorkbook.Activate
    
12.     Sheets("1").Activate
    
13.     arrPos = Array(0, "al3", "al100", "al200", "al300", "al400")
    
14.     For i = 1 To 5
    
15.         With Workbooks.Open(ThisWorkbook.Path & "\book" & i & ".xls")
    
16.             arr = .Sheets(6).Range("A2:E95").Value
    
17.             .Close True
    
18.         End With
    
19.         ActiveSheet.Range(arrPos(i)).Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
20.     Next
    
21.    
    
22.     Application.DisplayAlerts = True
    
23.     Application.ScreenUpdating = True
    
24.     Application.Calculation = xlCalculationAutomatic
    
25.     Application.EnableEvents = True
    
26.     MsgBox "OK"
    
27.    
    
28. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub 总数()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlCalculationManual
   
5.     Application.EnableEvents = False
   
6.     With Workbooks.Open(ThisWorkbook.Path & "\book1.xls")
   
7.         .Sheets(6).Range("A2:E95").Copy ThisWorkbook.Sheets(1).Range("AL3")
   
8.         .Close True
   
9.     End With
   
10.     With Workbooks.Open(ThisWorkbook.Path & "\book2.xls")
    
11.         .Sheets(6).Range("A2:E95").Copy ThisWorkbook.Sheets(1).Range("AL100")
    
12.         .Close True
    
13.     End With
    
14.     With Workbooks.Open(ThisWorkbook.Path & "\book3.xls")
    
15.         .Sheets(6).Range("A2:E95").Copy ThisWorkbook.Sheets(1).Range("AL200")
    
16.         .Close True
    
17.     End With
    
18.     With Workbooks.Open(ThisWorkbook.Path & "\book4.xls")
    
19.         .Sheets(6).Range("A2:E95").Copy ThisWorkbook.Sheets(1).Range("AL300")
    
20.         .Close True
    
21.     End With
    
22.     With Workbooks.Open(ThisWorkbook.Path & "\book5.xls")
    
23.         .Sheets(6).Range("A2:E95").Copy ThisWorkbook.Sheets(1).Range("AL400")
    
24.         .Close True
    
25.     End With
    
26.     Application.DisplayAlerts = True
    
27.     Application.ScreenUpdating = True
    
28.     Application.Calculation = xlCalculationAutomatic
    
29.     Application.EnableEvents = True
    
30. End Sub
    

复制代码

不知道你的代码是不是在book50.xls里。

如果要更快，可以用数组的方法。

hwc2ycy

1. Sub 总数()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlCalculationManual
   
5.     Application.EnableEvents = False
   
6.     Dim arr
   
7.     arr = Array(0, "al3", "al100", "al200", "al300", "al400")
   
8.     For i = 1 To 5
   
9.         With Workbooks.Open(ThisWorkbook.Path & "\book" & i & ".xls")
   
10.             arr = .Sheets(6).Range("A2:E95").Value
    
11.             ThisWorkbook.Sheets(1).Range(arr(i)).Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
12.             .Close True
    
13.         End With
    
14.     Next
    
15.     Application.DisplayAlerts = True
    
16.     Application.ScreenUpdating = True
    
17.     Application.Calculation = xlCalculationAutomatic
    
18.     Application.EnableEvents = True
    
19. End Sub

复制代码

hwc2ycy

1. Sub 总数()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlCalculationManual
   
5.     Application.EnableEvents = False
   
6.    
   
7.     Dim arr
   
8.     Dim i As Byte
   
9.    
   
10.     ThisWorkbook.Activate
    
11.     Sheets("1").Activate
    
12.     arr = Array(0, "al3", "al100", "al200", "al300", "al400")
    
13.     For i = 1 To 5
    
14.         With Workbooks.Open(ThisWorkbook.Path & "\book" & i & ".xls")
    
15.             arr = .Sheets(6).Range("A2:E95").Value
    
16.             .Close True
    
17.         End With
    
18.         ActiveSheet.Range(arr(i)).Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
19.     Next
    
20.    
    
21.     Application.DisplayAlerts = True
    
22.     Application.ScreenUpdating = True
    
23.     Application.Calculation = xlCalculationAutomatic
    
24.     Application.EnableEvents = True
    
25.     MsgBox "OK"
    
26.    
    
27. End Sub

复制代码

fghji

hwc2ycy 发表于 2013-6-17 13:28

代码是在book50里,但第一个提示错误424,第三个提示错误9

hwc2ycy

数组搞错了。

1. Sub 总数()
   
2.     Application.DisplayAlerts = False
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlCalculationManual
   
5.     Application.EnableEvents = False
   
6.    
   
7.     Dim arr
   
8.     Dim arrPos
   
9.     Dim i As Byte
   
10.    
    
11.     ThisWorkbook.Activate
    
12.     Sheets("1").Activate
    
13.     arrPos = Array(0, "al3", "al100", "al200", "al300", "al400")
    
14.     For i = 1 To 5
    
15.         With Workbooks.Open(ThisWorkbook.Path & "\book" & i & ".xls")
    
16.             arr = .Sheets(6).Range("A2:E95").Value
    
17.             .Close True
    
18.         End With
    
19.         ActiveSheet.Range(arrPos(i)).Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
20.     Next
    
21.    
    
22.     Application.DisplayAlerts = True
    
23.     Application.ScreenUpdating = True
    
24.     Application.Calculation = xlCalculationAutomatic
    
25.     Application.EnableEvents = True
    
26.     MsgBox "OK"
    
27.    
    
28. End Sub

复制代码

hwc2ycy

另外 ，你的是BOOK50里有工作表名为1的工作表？