[已解决]请vba大师帮忙简化代码

武林长风

下面的代码是录制的宏，用于把成绩单工作簿里1-6年级工作表（每个年级一个工作表）的A到I列复制到考试成绩统计工作簿1-6年级工作表（每个年级一个工作表）的A到I列。谢谢！！！ 新建文件夹.rar (360.75 KB, 下载次数: 1)

2015-7-14 15:29 上传

点击文件名下载附件
Sub Macro3()
'
' Macro3 Macro
'

'
    Sheets("一年级").Select
    Columns("A:I").Select
    Selection.Copy
    Windows("考试成绩统计）.xls").Activate
    Sheets("一年级").Select
    Columns("A:I").Select
    ActiveSheet.Paste
    Windows("成绩单.xls").Activate
    Sheets("二年级").Select
    Columns("A:I").Select
    Range("A275").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("考试成绩统计）.xls").Activate
    Sheets("二年级").Select
    Columns("A:I").Select
    Range("A607").Activate
    ActiveSheet.Paste
    Windows("成绩单.xls").Activate
    Sheets("三年级").Select
    Columns("A:I").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("考试成绩统计）.xls").Activate
    Sheets("三年级").Select
    Columns("A:I").Select
    Range("A619").Activate
    ActiveSheet.Paste
    Windows("成绩单.xls").Activate
    Sheets("四年级").Select
    Columns("A:I").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("考试成绩统计）.xls").Activate
    Sheets("四年级").Select
    Columns("A:I").Select
    Range("A1637").Activate
    ActiveSheet.Paste
    Windows("成绩单.xls").Activate
    Sheets("五年级").Select
    Columns("A:I").Select
    Range("A1438").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("考试成绩统计）.xls").Activate
    Sheets("五年级").Select
    Columns("A:I").Select
    Range("A407").Activate
    ActiveSheet.Paste
    Windows("成绩单.xls").Activate
    Sheets("六年级").Select
    Columns("A:I").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("考试成绩统计）.xls").Activate
    Sheets("六年级").Select
    Columns("A:I").Select
    Range("A1072").Activate
    ActiveSheet.Paste
End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2015-7-14 15:47

1. Sub 复制成绩()
   
2.     Application.Calculation = xlCalculationManual
   
3.     On Error Resume Next
   
4.     Dim wb As Workbook, sh As Worksheet
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\导成绩单.xls")
   
6.     For Each sh In wb.Worksheets
   
7.         If sh.Name Like "*年级" Then sh.[a:i].Copy ThisWorkbook.Sheets(sh.Name).[a:i]
   
8.     Next
   
9.     wb.Close False
   
10.     Application.Calculation = xlCalculationAutomatic
    
11. End Sub
    

复制代码

跳转到最佳答案楼层

爱疯

还是上传附件，说明题意，一目了然。

武林长风

爱疯 发表于 2015-7-14 14:47
还是上传附件，说明题意，一目了然。

谢谢爱疯老师！ 新建文件夹.rar (360.75 KB, 下载次数: 3)

2015-7-14 15:23 上传

点击文件名下载附件

grf1973

1. Sub 复制成绩()
   
2.     Application.Calculation = xlCalculationManual
   
3.     On Error Resume Next
   
4.     Dim wb As Workbook, sh As Worksheet
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\导成绩单.xls")
   
6.     For Each sh In wb.Worksheets
   
7.         If sh.Name Like "*年级" Then sh.[a:i].Copy ThisWorkbook.Sheets(sh.Name).[a:i]
   
8.     Next
   
9.     wb.Close False
   
10.     Application.Calculation = xlCalculationAutomatic
    
11. End Sub
    

复制代码

爱疯

Sub test()
    Dim wk1, wk2, i
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Call test2

    Set wk2 = ThisWorkbook
    Set wk1 = Workbooks.Open(wk2.Path & "\导成绩单.xls")
    For i = 2 To 7
        wk1.Sheets(i).Range("a1").CurrentRegion.Copy wk2.Sheets(i).Range("a1")
    Next i

    Call test2
'    Application.Calculation = xlAutomatic
End Sub

Sub test2()
    On Error Resume Next
    Workbooks("导成绩单.xls").Close False
    On Error GoTo 0
End Sub

新建文件夹2.rar (617.29 KB, 下载次数: 1)

2015-7-14 15:46 上传

点击文件名下载附件



如果希望"考试成绩统计.xls"自动计算，则取消test()最后1句的注释。

grf1973

1. Sub 复制成绩()
   
2.     Application.Calculation = xlCalculationManual
   
3.     On Error Resume Next
   
4.     Dim wb As Workbook, sh As Worksheet
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\导成绩单.xls")
   
6.     For Each sh In wb.Worksheets
   
7.         If sh.Name Like "*年级" Then sh.[a:i].Copy ThisWorkbook.Sheets(sh.Name).[a:i]
   
8.     Next
   
9.     wb.Close False
   
10.     Application.Calculation = xlCalculationAutomatic
    
11. End Sub
    

复制代码

grf1973

怎么会发了两遍。。。。。。。。。。