Code efficiency

[rhaney]

This code from the Excel Macro Recorder works, and does what I need, but it is not efficient. Can someone please help me and make it more efficient?
Thank you in advance for your assistance!
Robert

Sub Macro1()
'
' Macro1 Macro
'Round 1 Topic 1 Question $100
'
'
    Sheets("Setup Page").Select
    Range("E11:AA12").Select
    Selection.Copy
    Sheets("Game Page Round 1").Select
    Range("G40:AC41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Setup Page").Select
    Range("D11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Game Page Round 1").Select
    Range("A40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Setup Page").Select
    Range("AC11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Game Page Round 1").Select
    Range("P42").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Game Page Round 1").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 61")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ""
    Range("A1").Select
End Sub

 

[dreid1011]

You could change the red portions to each following blue section.

Sub Macro1()
'
' Macro1 Macro
'Round 1 Topic 1 Question $100
'
'
    [COLOR=#ff0000]Sheets("Setup Page").Select
    Range("E11:AA12").Select
    Selection.Copy
    Sheets("Game Page Round 1").Select
    Range("G40:AC41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False[/COLOR]

[COLOR=#0000ff]Sheets("Setup Page").Range("E11:AA12").Copy Sheets("Game Page Round 1").Range("G40:AC41")[/COLOR]

    [COLOR=#ff0000]Sheets("Setup Page").Select
    Range("D11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Game Page Round 1").Select
    Range("A40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

[/COLOR][COLOR=#0000ff]Sheets("Setup Page").Range("D11").Copy Sheets("Game Page Round 1").Range("A40")
[/COLOR]
[COLOR=#FF0000]    Range("A41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False[/COLOR]

[COLOR=#0000ff]Sheets("Setup Page").Range("D11").Copy Sheets("Game Page Round 1").Range("A41")[/COLOR]

    [COLOR=#ff0000]Sheets("Setup Page").Select
    Range("AC11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Game Page Round 1").Select
    Range("P42").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False[/COLOR]
[COLOR=#0000ff]
Sheets("Setup Page").Range("AC11").Copy Sheets("Game Page Round 1").Range("P42")[/COLOR]

    Sheets("Game Page Round 1").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 61")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ""
    Range("A1").Select
End Sub

I wasn't sure what you are doing with A41, so I left it alone.

Edit: Copying D11 into both A40 and A41?

 

[BrianJN1]

Give this a try. I've only begun editing Recorder's VBA so be wary.

Just one thought though, should you have both A40 and A41 receiving the same data from the D11 cell just above them?

Sub Macro1()
        '
        ' Macro1 Macro
        'Round 1 Topic 1 Question $100
        '
        '
            Sheets("Setup Page").Select
            Range("E11:AA12").Copy
            Sheets("Game Page Round 1").Select
            Range("G40:AC41").PasteSpecial
                
            Sheets("Setup Page").Select
            [COLOR=#ff0000]Range("D11").Copy[/COLOR]
            Sheets("Game Page Round 1").Select
            [COLOR=#ff0000]Range("A40").PasteSpecial
            Range("A41").PasteSpecial[/COLOR]
            
            Sheets("Setup Page").Select
            Range("AC11").Copy
            Sheets("Game Page Round 1").Select
            Range("P42").PasteSpecial
            Sheets("Game Page Round 1").Select
            ActiveSheet.Shapes.Range(Array("Rounded Rectangle 61")).ShapeRange(1).TextFrame2.TextRange.Characters.Text = ""
            Range("A1").Select
        End Sub

 

[Kenneth Hobson]

I did one for you. See the commented link if not clear.

Sub Test()
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  'Sheets("Setup Page").Select
  'Range("E11:AA12").Select
  'Selection.Copy
  'Sheets("Game Page Round 1").Select
  'Range("G40:AC41").Select
  'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
      
  'Beyond Macro Recorder: http://www.tushar-mehta.com/excel/vba/beyond_the_macro_recorder/index.htm
  Sheets("Setup Page").Range("E11:AA12").Copy
  Sheets("Game Page Round 1").Range("G40:AC41").PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  '....
  
  
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub

 

[footoo]

How long is your code taking?
I don't think cleaning up the code will make much difference.

Sub FT()
Dim sp As Worksheet: Set sp = Sheets("Setup Page")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
With Sheets("Game Page Round 1")
    .[G40:AC41] = sp.[E11:AA12].Value
    .[A40] = sp.[D11].Value
    .[A41] = sp.[D11].Value
    .[P42] = sp.[AC11].Value
    .Select
End With
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 61")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ""
Range("A1").Select
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub