VBA - Scaling consolidation, need to shorten the codes
.everyoneloves__top-leaderboard:empty,.everyoneloves__mid-leaderboard:empty,.everyoneloves__bot-mid-leaderboard:empty{ height:90px;width:728px;box-sizing:border-box;
}
0
Does anyone know how to shorten the following macro? The idea is to copy a range in each worksheet (9 worksheets total, could be more later) and paste into the consolidated worksheet (Sheet999) - each range copied/appended successively, one right after the other. This code works fine, but hoping to shorten it by using "For i = " or something like that. I tried, but to no avail.
Sub AAA_Consolidate()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim sh7 As Worksheet
Dim sh8 As Worksheet
Dim sh9 As Worksheet
Sheets("B").Select
r1 = Range("Q6").Value
r2 = Range("Q7").Value
r3 = Range("Q8").Value
r4 = Range("Q9").Value
r5 = Range("Q10").Value
r6 = Range("Q11").Value
r7 = Range("Q12").Value
r8 = Range("Q13").Value
r9 = Range("Q14").Value
rr1 = Range("R6").Value
rr2 = Range("R7").Value
rr3 = Range("R8").Value
rr4 = Range("R9").Value
rr5 = Range("R10").Value
rr6 = Range("R11").Value
rr7 = Range("R12").Value
rr8 = Range("R13").Value
rr9 = Range("R14").Value
With ActiveWorkbook
Set sh1 = .Sheets("Sheet1")
Set sh2 = .Sheets("Sheet2")
Set sh3 = .Sheets("Sheet3")
Set sh4 = .Sheets("Sheet4")
Set sh5 = .Sheets("Sheet5")
Set sh6 = .Sheets("Sheet6")
Set sh7 = .Sheets("Sheet7")
Set sh8 = .Sheets("Sheet8")
Set sh9 = .Sheets("Sheet9")
Set sh99 = .Sheets("Sheet999")
sh99.Select
sh1.Range("C1:H" & r1).Copy
sh99.Select
sh99.Range("B" & rr1).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh2.Range("C1:H" & r2).Copy
sh99.Select
sh99.Range("B" & rr2).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh3.Range("C1:H" & r3).Copy
sh99.Select
sh99.Range("B" & rr3).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh4.Range("C1:H" & r4).Copy
sh99.Select
sh99.Range("B" & rr4).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh5.Range("C1:H" & r5).Copy
sh99.Select
sh99.Range("B" & rr5).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh6.Range("C1:H" & r6).Copy
sh99.Select
sh99.Range("B" & rr6).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh7.Range("C1:H" & r7).Copy
sh99.Select
sh99.Range("B" & rr7).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh8.Range("C1:H" & r8).Copy
sh99.Select
sh99.Range("B" & rr8).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh9.Range("C1:H" & r9).Copy
sh99.Range("B" & rr9).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
Range("G4").Select
End With
End Sub
windows microsoft-excel-2016
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
add a comment |
0
Does anyone know how to shorten the following macro? The idea is to copy a range in each worksheet (9 worksheets total, could be more later) and paste into the consolidated worksheet (Sheet999) - each range copied/appended successively, one right after the other. This code works fine, but hoping to shorten it by using "For i = " or something like that. I tried, but to no avail.
Sub AAA_Consolidate()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim sh7 As Worksheet
Dim sh8 As Worksheet
Dim sh9 As Worksheet
Sheets("B").Select
r1 = Range("Q6").Value
r2 = Range("Q7").Value
r3 = Range("Q8").Value
r4 = Range("Q9").Value
r5 = Range("Q10").Value
r6 = Range("Q11").Value
r7 = Range("Q12").Value
r8 = Range("Q13").Value
r9 = Range("Q14").Value
rr1 = Range("R6").Value
rr2 = Range("R7").Value
rr3 = Range("R8").Value
rr4 = Range("R9").Value
rr5 = Range("R10").Value
rr6 = Range("R11").Value
rr7 = Range("R12").Value
rr8 = Range("R13").Value
rr9 = Range("R14").Value
With ActiveWorkbook
Set sh1 = .Sheets("Sheet1")
Set sh2 = .Sheets("Sheet2")
Set sh3 = .Sheets("Sheet3")
Set sh4 = .Sheets("Sheet4")
Set sh5 = .Sheets("Sheet5")
Set sh6 = .Sheets("Sheet6")
Set sh7 = .Sheets("Sheet7")
Set sh8 = .Sheets("Sheet8")
Set sh9 = .Sheets("Sheet9")
Set sh99 = .Sheets("Sheet999")
sh99.Select
sh1.Range("C1:H" & r1).Copy
sh99.Select
sh99.Range("B" & rr1).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh2.Range("C1:H" & r2).Copy
sh99.Select
sh99.Range("B" & rr2).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh3.Range("C1:H" & r3).Copy
sh99.Select
sh99.Range("B" & rr3).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh4.Range("C1:H" & r4).Copy
sh99.Select
sh99.Range("B" & rr4).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh5.Range("C1:H" & r5).Copy
sh99.Select
sh99.Range("B" & rr5).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh6.Range("C1:H" & r6).Copy
sh99.Select
sh99.Range("B" & rr6).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh7.Range("C1:H" & r7).Copy
sh99.Select
sh99.Range("B" & rr7).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh8.Range("C1:H" & r8).Copy
sh99.Select
sh99.Range("B" & rr8).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh9.Range("C1:H" & r9).Copy
sh99.Range("B" & rr9).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
Range("G4").Select
End With
End Sub
windows microsoft-excel-2016
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
add a comment |
0
0
0
Does anyone know how to shorten the following macro? The idea is to copy a range in each worksheet (9 worksheets total, could be more later) and paste into the consolidated worksheet (Sheet999) - each range copied/appended successively, one right after the other. This code works fine, but hoping to shorten it by using "For i = " or something like that. I tried, but to no avail.
Sub AAA_Consolidate()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim sh7 As Worksheet
Dim sh8 As Worksheet
Dim sh9 As Worksheet
Sheets("B").Select
r1 = Range("Q6").Value
r2 = Range("Q7").Value
r3 = Range("Q8").Value
r4 = Range("Q9").Value
r5 = Range("Q10").Value
r6 = Range("Q11").Value
r7 = Range("Q12").Value
r8 = Range("Q13").Value
r9 = Range("Q14").Value
rr1 = Range("R6").Value
rr2 = Range("R7").Value
rr3 = Range("R8").Value
rr4 = Range("R9").Value
rr5 = Range("R10").Value
rr6 = Range("R11").Value
rr7 = Range("R12").Value
rr8 = Range("R13").Value
rr9 = Range("R14").Value
With ActiveWorkbook
Set sh1 = .Sheets("Sheet1")
Set sh2 = .Sheets("Sheet2")
Set sh3 = .Sheets("Sheet3")
Set sh4 = .Sheets("Sheet4")
Set sh5 = .Sheets("Sheet5")
Set sh6 = .Sheets("Sheet6")
Set sh7 = .Sheets("Sheet7")
Set sh8 = .Sheets("Sheet8")
Set sh9 = .Sheets("Sheet9")
Set sh99 = .Sheets("Sheet999")
sh99.Select
sh1.Range("C1:H" & r1).Copy
sh99.Select
sh99.Range("B" & rr1).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh2.Range("C1:H" & r2).Copy
sh99.Select
sh99.Range("B" & rr2).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh3.Range("C1:H" & r3).Copy
sh99.Select
sh99.Range("B" & rr3).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh4.Range("C1:H" & r4).Copy
sh99.Select
sh99.Range("B" & rr4).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh5.Range("C1:H" & r5).Copy
sh99.Select
sh99.Range("B" & rr5).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh6.Range("C1:H" & r6).Copy
sh99.Select
sh99.Range("B" & rr6).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh7.Range("C1:H" & r7).Copy
sh99.Select
sh99.Range("B" & rr7).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh8.Range("C1:H" & r8).Copy
sh99.Select
sh99.Range("B" & rr8).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh9.Range("C1:H" & r9).Copy
sh99.Range("B" & rr9).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
Range("G4").Select
End With
End Sub
windows microsoft-excel-2016
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
Does anyone know how to shorten the following macro? The idea is to copy a range in each worksheet (9 worksheets total, could be more later) and paste into the consolidated worksheet (Sheet999) - each range copied/appended successively, one right after the other. This code works fine, but hoping to shorten it by using "For i = " or something like that. I tried, but to no avail.
Sub AAA_Consolidate()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet
Dim sh7 As Worksheet
Dim sh8 As Worksheet
Dim sh9 As Worksheet
Sheets("B").Select
r1 = Range("Q6").Value
r2 = Range("Q7").Value
r3 = Range("Q8").Value
r4 = Range("Q9").Value
r5 = Range("Q10").Value
r6 = Range("Q11").Value
r7 = Range("Q12").Value
r8 = Range("Q13").Value
r9 = Range("Q14").Value
rr1 = Range("R6").Value
rr2 = Range("R7").Value
rr3 = Range("R8").Value
rr4 = Range("R9").Value
rr5 = Range("R10").Value
rr6 = Range("R11").Value
rr7 = Range("R12").Value
rr8 = Range("R13").Value
rr9 = Range("R14").Value
With ActiveWorkbook
Set sh1 = .Sheets("Sheet1")
Set sh2 = .Sheets("Sheet2")
Set sh3 = .Sheets("Sheet3")
Set sh4 = .Sheets("Sheet4")
Set sh5 = .Sheets("Sheet5")
Set sh6 = .Sheets("Sheet6")
Set sh7 = .Sheets("Sheet7")
Set sh8 = .Sheets("Sheet8")
Set sh9 = .Sheets("Sheet9")
Set sh99 = .Sheets("Sheet999")
sh99.Select
sh1.Range("C1:H" & r1).Copy
sh99.Select
sh99.Range("B" & rr1).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh2.Range("C1:H" & r2).Copy
sh99.Select
sh99.Range("B" & rr2).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh3.Range("C1:H" & r3).Copy
sh99.Select
sh99.Range("B" & rr3).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh4.Range("C1:H" & r4).Copy
sh99.Select
sh99.Range("B" & rr4).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh5.Range("C1:H" & r5).Copy
sh99.Select
sh99.Range("B" & rr5).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh6.Range("C1:H" & r6).Copy
sh99.Select
sh99.Range("B" & rr6).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh7.Range("C1:H" & r7).Copy
sh99.Select
sh99.Range("B" & rr7).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh8.Range("C1:H" & r8).Copy
sh99.Select
sh99.Range("B" & rr8).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
sh9.Range("C1:H" & r9).Copy
sh99.Range("B" & rr9).Select
ActiveSheet.Paste
ActiveSheet.Paste Link:=True
Range("G4").Select
End With
End Sub
windows microsoft-excel-2016
windows microsoft-excel-2016
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
asked Mar 12 at 1:23
SofiaEdSofiaEd
114
114
add a comment |
add a comment |
0
active
oldest
votes
Your Answer
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "3"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fsuperuser.com%2fquestions%2f1413261%2fvba-scaling-consolidation-need-to-shorten-the-codes%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
0
active
oldest
votes
0
active
oldest
votes
active
oldest
votes
active
oldest
votes
draft saved
draft discarded
Thanks for contributing an answer to Super User!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fsuperuser.com%2fquestions%2f1413261%2fvba-scaling-consolidation-need-to-shorten-the-codes%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
