Looping through several worksheets and certain ranges in those worksheets

[Madmanz]

Alright, I am making a to do list that is pretty automated that will add sheets and delete sheets as the days move forward (Dates in the past will be saved to a folder and deleted, current/future dates will remain).

This is the bit of code i'm having a lot of trouble with. The main functionality that i'm after is to loop through all sheets that are named as being in the past (Dec 12 2017, Dec 11 2017, etc) and if 'true' then loops through those specified cells and copy all the jobs that are incomplete and paste them into Today's sheet, and repeat loop if there's another sheet who's condition is 'true'.

I've nearly got it working, but am having issues with referring to Ranges on the sheets that are being looped through (Currently it will only loop through the cells on the active sheet)

I've been stuck on this for quite some time and was hoping for some help here, thank you.

    Dim ws As Worksheet    
    Dim rCell As Range
    Dim rRng As Range
    
    Dim CurrentDate As String
    
    CurrentDate = Format(Now, "d mmm yyyy")
    
    Set rRng = Range("C5:C58")
    
    For Each ws In Worksheets           'loops through worksheets that are in the past (yesterday, etc)
    If ws.Range("ab1") < Now - 1 Then   'cell "ab1" has a formula that calculates todays date as the current sheet
                                        'and if "ab1" is less then Todays date (yesterday) then start the Range loop
        For Each rCell In rRng.Cells
        If rCell <> "" And rCell.Offset(0, -1).Value = "o" Then 'finds all jobs that havent been completed on the sheet
            Sheets(CurrentDate).Unprotect                       'by looping through all the specified cells and only copy those cells
                
            rCell.Resize(1, 5).Copy  'copy the incompleted jobs
            Sheets(CurrentDate).Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats 'paste incomplete jobs
                                                                                                                       'from yesterday to current day
            Sheets(CurrentDate).Protect
        End If
        Next rCell
        
    End If
    Next ws

 

[Madmanz]

Well, I found the problem, the part highlighted in bold (kept placing it in the wrong parts of my code.)

Couldn't find anything out there that loops through worksheets and then their specified ranges in a nested loop, so here it is.

Application.DisplayAlerts = False
            
    Dim ws As Worksheet
    
    Dim rCell As Range
    Dim rRng As Range
    
    Dim CurrentDate As String
    
    CurrentDate = Format(Now, "d mmm yyyy")
    
    On Error Resume Next
    For Each ws In Worksheets
    
    If ws.Range("ab1") < Now - 1 And ws.Name <> "Sheet1" Then 'cell ab1 resembles the date
    Set rRng = ws.Range("C5:C58")
        For Each rCell In rRng.Cells
           
            If rCell <> "" And rCell.Offset(0, -1).Value = "o" Then   ' "o" resembles a check mark and finds all jobs that havent been completed on the sheet
                Sheets(CurrentDate).Unprotect
                rCell.Resize(1, 5).Copy 'Destination:=Sheets(CurrentDate).Range("C5:g5")  'tranfers the unfinished jobs to todays day
                Sheets(CurrentDate).Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
               
                Sheets(CurrentDate).Protect


            End If
        Next rCell
        
        If ws.Range("ab1") < Now - 1 And ws.Name <> "Sheet1" Then
            ActiveWorkbook.SaveAs "C:\" & ws.Name & ".xls", FileFormat:=xlNormal
            ws.Delete
        End If
    End If
    Next ws
    On Error GoTo -1