求助大神帮忙简化宏语言

81490833

各位大神，自己录制的一段宏，运行时间太长，希望可以帮忙简化下谢谢！
Sub 宏2()
'
' 宏2 宏
'

'
    Range("C15").Select
    Sheets("CR").Select
    ActiveWindow.SmallScroll Down:=-18
    Range("F2").Select
    ActiveWindow.SmallScroll Down:=12
    Range("F2:F21").Select
    Selection.Copy
    Sheets("Report").Select
    Range("C15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D15").Select
    Sheets("CR").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("J2").Select
    ActiveWindow.SmallScroll Down:=12
    Range("J2:K21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=6
    Range("F15").Select
    Sheets("CR").Select
    ActiveWindow.SmallScroll Down:=-18
    Range("Q2").Select
    ActiveWindow.SmallScroll Down:=9
    Range("Q2:Q21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G15").Select
    Sheets("CR").Select
    ActiveWindow.SmallScroll Down:=-18
    Range("Y2").Select
    ActiveWindow.SmallScroll Down:=9
    Range("Y2:Y21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H15").Select
    Sheets("CR").Select
    ActiveWindow.SmallScroll Down:=-24
    Range("P2").Select
    ActiveWindow.SmallScroll Down:=12
    Range("P2:P21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I15").Select
    Sheets("CR").Select
    ActiveWindow.SmallScroll Down:=-30
    Range("Z2").Select
    ActiveWindow.SmallScroll Down:=9
    Range("Z2:Z21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=24
    Range("C40").Select
    Sheets("Reject").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("F2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("F2:F31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Range("C40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D40").Select
    Sheets("Reject").Select
    ActiveWindow.SmallScroll Down:=-45
    Range("J2").Select
    ActiveWindow.SmallScroll Down:=24
    Range("J2:K31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F40").Select
    Sheets("Reject").Select
    ActiveWindow.SmallScroll Down:=-39
    Range("Q2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("Q2:Q31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G40").Select
    Sheets("Reject").Select
    ActiveWindow.SmallScroll Down:=-30
    Range("T2").Select
    ActiveWindow.SmallScroll Down:=27
    Range("T2:T31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H40").Select
    Sheets("Reject").Select
    ActiveWindow.SmallScroll Down:=-45
    Range("P2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("P2:P31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=36
    Range("C77").Select
    ActiveWindow.SmallScroll Down:=3
    Sheets("Underweight").Select
    Range("F2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("F2:F31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Range("C77").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D77").Select
    Sheets("Underweight").Select
    ActiveWindow.SmallScroll Down:=-36
    Range("J2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("J2:K31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F77").Select
    Sheets("Underweight").Select
    ActiveWindow.SmallScroll Down:=-36
    Range("Y2").Select
    ActiveWindow.SmallScroll Down:=21
    Range("Y2:Y31").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Report").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G77").Select
    ActiveWindow.SmallScroll Down:=-33
End Sub

opel-wong

上传附件，说明要求，模拟结果，答案自然有来了，

shenjianrong163

楼主这段代码让人眼睛都看花，建议发一个附件，然后说清楚要实现的功能。

3190496160

上传附件，说明需求，录制的宏没有修改的价值

81490833

谢谢大家的回复，感谢

liulang0808

1. 
   
2.     Sheets("CR").Select
   
3.     ActiveWindow.SmallScroll Down:=-18
   
4.     Range("F2").Select
   
5.     ActiveWindow.SmallScroll Down:=12
   
6.     Range("F2:F21").Select
   
7.     Selection.Copy
   
8.     Sheets("Report").Select
   
9.     Range("C15").Select
   
10.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
11.         :=False, Transpose:=False
    
12.         
    
13. 以上代码修改成下面红色的，其他雷同
    
14.        [color=Red] Sheets("Report").Range("C15").Resize(20).Value = Sheets("CR").Range("F2:F21").Value[/color]

复制代码

YZC51

81490833 发表于 2020-2-19 16:14
谢谢大家的回复，感谢

上传附件，方便测试！