Loop through specific worksheets in a collection

[VBA-Apprentice]

Hi All,

I am working on a VBA code that would loop through collection of worksheets (~40 sheets) in a workbook and would specifically pick and copy cells which are coloured in a particular worksheet and then paste the copied range on a separate sheet in the same workbook. I tried to nest a For Next loop (to loop through sheets) with the loop which you have shown in your video. Now the problem here is the loop is working fine within a given sheet i.e. it is selecting or copying a coloured range and moving on to a next coloured range perfectly, but then it is not looping to next sheet in the collection which also has coloured ranges to be copied.


Can someone please help me on this?

Here is the code that I've written:

Sub loopthroughsheets()


Dim WS_Count As Integer
Dim irow As Long
Dim lr As Long ' last row
Dim n As Long ' loopcounter for looping to next sheet
Dim i As Long ' loopcounter for looping cells in a sheet




WS_Count = ActiveWorkbook.Worksheets.<wbr>Count

For n = 6 To WS_Count
lr = Worksheets.Cells(Rows.<wbr>Count, 1).End(xlUp).Row
If 2 > lr Then Exit Sub
irow = 2

For i = 2 To lr
If Cells(i, 1).Interior.Color <> 16777215 Then
Cells(i, 1).Resize(1, 7).Select
End If
Next i
Next n


End Sub

 

[Michael M]

Try activating the worksheet

Sub loopthroughsheets()
Dim WS_Count As Integer
Dim irow As Long
Dim lr As Long ' last row
Dim n As Integer ' loopcounter for looping to next sheet
Dim i As Long ' loopcounter for looping cells in a sheet
WS_Count = ActiveWorkbook.Worksheets.Count

For n = 1 To WS_Count
[color=red]Worksheets(n).Activate[/color]
lr = Worksheets(n).Cells(Rows.Count, 1).End(xlUp).Row
If 2 > lr Then Exit Sub
irow = 2

For i = 2 To lr
If Cells(i, 1).Interior.Color <> 16777215 Then
Cells(i, 1).Resize(1, 7).Select
End If
Next i
Next n


End Sub

 

[VBA-Apprentice]

Perfect! Thanks a lot for the help