VBA copy ranges from numerous sheets

[Akashwani]

Hi,

I have the following code which works great for one sheet.

Sub CopyInboundData()
Dim lr As Long
Dim lr2 As Long

Application.ScreenUpdating = False

Sheets("Inbound").Unprotect ("Password1")
Sheets("Master").Unprotect ("Password1")

lr = Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row + 1
lr2 = Sheets("Inbound").Cells(Rows.Count, 1).End(xlUp).Row ' + 1
   
    Sheets("Inbound").Range("A2:AJ" & lr2).Copy
    Sheets("Master").Activate
    Range("A" & lr).PasteSpecial xlValues

Sheets("Master").Protect ("Password1")
Sheets("Inbound").Select
Sheets("Inbound").Protect ("Password1")
Sheets("Master").Select

Application.ScreenUpdating = True
End Sub

I now have X sheets (to the left of Master) that I need to run this code on. I have worksheets to the right of Master that do not need copying.

I know that I could just change the sheet name from Inbound and create X number of macros and run them one after another, but I have a feeling that it will take sometime to go through all the sheets.

Any suggestions?

Thanks

Ak

 

[Airfix9]

Do the "X" sheets have some commonality to their names?

You could run a loop along the lines of:

dim i as integer
for i = 1 to thisworkbook.sheets.count
if thisworkbook.sheets(i).name = "SheetName" then' or whatever
DO MY CODE
end if

next i

You could also build in an exit for when it reaches the Master sheet.

 

[daverunt]

You could use an array of the sheets you want to work on:

arrWs = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")
 
For i = LBound(arrWs) To UBound(arrWs)
 
Sheets(arrWs(i)).Activate
 
.....Your Code
 
Next i

 

[Akashwani]

Hi Guys,

Thanks for replying.

Airfix9,
My sheet names do not have any common naming pattern.

Daverunt,
I have no idea how to apply your solution to my current code. I assume that I would need to at least change this line....

lr2 = Sheets("Inbound").Cells(Rows.Count, 1).End(xlUp).Row ' + 1

And this....

Sheets("Inbound").Range("A2:AJ" & lr2).Copy

I have mixed then together like this, this obviously doesn't work, so I would appreciate your corrections, but not laughter ....

Sub CopyInboundData()
Dim lr As Long
Dim lr2 As Long
Application.ScreenUpdating = False

arrWs = Array("Inbound", "Live", "Current", "Shared", "Unique")
 
For i = LBound(arrWs) To UBound(arrWs)
 
Sheets(arrWs(i)).Activate
 
Sheets("Master").Unprotect ("Password1")

lr = Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(arrWs(i)).Cells(Rows.Count, 1).End(xlUp).Row ' + 1
   
    Sheets(arrWs(i)).Range("A2:AJ" & lr2).Copy
    Sheets("Master").Activate
    Range("A" & lr).PasteSpecial xlValues


Sheets(arrWs(i)).Select
arrWs = Array("Inbound", "Live", "Current", "Shared", "Unique").Protect("Password1")
Sheets("Master").Select
Sheets("Master").Protect ("Password1")

Next i

Application.ScreenUpdating = True
End Sub

Thanks

Ak

 

[Airfix9]

Is the first sheet to import always the first sheet in the book then? If so, I can construct something that would work.

 

[GTO]

I may be missing something, but if wanting to just run against sheets "left" of Master, have you tried using "Master's" index?
<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br>    <br><SPAN style="color:#00007F">Sub</SPAN> exa4()<br><SPAN style="color:#00007F">Dim</SPAN> wksMaster <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> Index <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wksMaster = ThisWorkbook.Worksheets("Master")<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>    <br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> wksMaster <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        Index = wksMaster.Index<br>        <SPAN style="color:#00007F">If</SPAN> Index > 1 <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> Index - 1<br>                MsgBox "Do whatever here with " & ThisWorkbook.Worksheets(i).Name<br>            <SPAN style="color:#00007F">Next</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
Mark

 

[Akashwani]

Hi,

Airfix9,
Inbound is Sheet2 (1st sheet tab)
Live is Sheet3 (2nd sheet tab)
Current is Sheet6 (3rd sheet tab)
Shared is Sheet5 (4th sheet tab)
Unique is Sheet8 (5th sheet tab)
Master is Sheet1 (6th sheet tab)

GTO,
Thanks for your reply Mark, I have no idea whatsoever what to do with your code and mine, sorry. I am totally perplexed by all of this.

Thanks

Ak

 

[daverunt]

Hi,

It should be something along the lines of:

Sub CopyInboundData()
 
Dim lr As Long
Dim lr2 As Long
Application.ScreenUpdating = False
 
arrWs = Array("Inbound", "Live", "Current", "Shared", "Unique")
 
For i = LBound(arrWs) To UBound(arrWs)
 
Sheets("Master").Unprotect ("Password1")
lr = Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(arrWs(i)).Activate
lr2 = Sheets(arrWs(i)).Cells(Rows.Count, 1).End(xlUp).Row ' + 1
 
    Sheets(arrWs(i)).Range("A2:AJ" & lr2).Copy
    Sheets("Master").Activate
    Range("A" & lr).PasteSpecial xlValues
 
Sheets(arrWs(i)).Select
Next i
 
For x = LBound(arrWs) To UBound(arrWs)
       Sheets(arrWs(x)).Protect ("Password1")
Next x
     Sheets("Master").Select
     Sheets("Master").Protect ("Password1")
     Application.ScreenUpdating = True
End Sub

 

[Akashwani]

Re: VBA copy ranges from numerous sheets (SOLVED)

Hi Daverunt,

Thank you very much for your solution, it does exactly as required.

This site is great.

Thank's to you all for your contributions.

Ak