truck90coo
New member
- Joined
- Aug 19, 2015
- Messages
- 1
- Reaction score
- 0
- Points
- 0
I have a macro that is looking at two tabs in a spreadsheet and making "Scorecards" based off of those tabs. The macro is basically doing the same thing, 100+ times, with only the range changing, to reflect the next set of data. Below is a snippet of what it is doing. How can I shrink this down, to run 200 times, as it is to large to add any new lines to it
Code:
Sub MakeIndividualScorecards()
Sheets("RCM List").Select
Range("A2:Q2").Select
Selection.Copy
Sheets("Scorecard").Select
Range("G4").Select
ActiveSheet.Paste
Sheets("Scorecard").Select
Application.CutCopyMode = False
Sheets("Scorecard").Copy Before:=Sheets(1)
Cells.Select
Range("D1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RCM List").Select
Range("A3:Q3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Scorecard").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Scorecard").Select
Application.CutCopyMode = False
Sheets("Scorecard").Copy Before:=Sheets(1)
Cells.Select
Range("D1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RCM List").Select
Range("A4:Q4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Scorecard").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Scorecard").Select
Application.CutCopyMode = False
Sheets("Scorecard").Copy Before:=Sheets(1)
Cells.Select
Range("D1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RCM List").Select
Range("A5:Q5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Scorecard").Select
Range("G4").Select
ActiveSheet.Paste
Sheets("Scorecard").Select
Application.CutCopyMode = False
Sheets("Scorecard").Copy Before:=Sheets(1)
Cells.Select
Range("D1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Last edited by a moderator: