Macro Loop Assistance

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:
truck90coo, this is a cross post (you have posted the same query elsewhere (on several other forums, with several responses)) without including links to where you have done so.
Please have a careful read of http://www.excelguru.ca/content.php?184 to understand why this important, then make the necessary additions of links to all sites/threads.
Ultimately, truck90coo, it will be to your benefit.

To others, I would prefer if people considering responding to this thread would delay doing so until truck90coo has complied.
 
Last edited:
Back
Top