VBA - If range is beyond the active worksheet

[RuinAerlin]

Hi All,

I've put a sample of my code below (it repeats for every 6th column up to GW). I get a run time error '91' Object Variable or With Block variable not set when the worksheet does not extend that many columns e.g. on my 3rd tab it only goes up to EN and I debugger highlights the line;

Lastrow = Range("EO:EO").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

What I am trying to do is if the worksheet doesn't extend that far, go to workinprogress.

Dim i As Integer
    For i = 2 To Worksheets.Count
        Sheets(i).Select
Dim Lastrow As Long
    Dim LR As Long
If Not Range("G:G") Is Nothing Then
 Lastrow = Range("G:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 End If
Range("G4:K" & Lastrow).Select
    Selection.Copy
LR = Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A" & LR).Offset(1).Select
    ActiveSheet.Paste
On Error GoTo workinprogress
If Not Range("M:M") Is Nothing Then
 Lastrow = Range("M:M").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 End If
Range("M4:Q" & Lastrow).Select
    Selection.Copy
LR = Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A" & LR).Offset(1).Select
    ActiveSheet.Paste
On Error GoTo workinprogress

workinprogress:
Lastrow = Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A4:E" & Lastrow).Select
    Selection.Copy
    Sheets("WIP").Select
 Lastrow = Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A" & Lastrow).Select
    ActiveSheet.Paste
    Next i

 

[Norie]

How about something like this?

Dim i As Integer
Dim Lastrow As Long
Dim LR As Long
Dim rngFnd As Range
Dim rngLook As Range

    For i = 2 To Worksheets.Count
    
        With Sheets(i)
            Set rngLook = .Range("G:G")
            Do
                Set rngFnd = rngLook.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            
                If Not rngFnd Is Nothing Then
                    Lastrow = rngFnd.Row
                    .Range(.Cells(4, rngLook.Column), .Cells(Lastrow, rngLook.Column + 5)).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
                End If
                
                Set rngFnd = rngFnd.Offset(, 6)
            Loop Until rngFnd Is Nothing
        
workinprogress:
            Lastrow = .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A4:E" & Lastrow).Copy Sheets("WIP").Range("A" & Rows.Count).End(xlUp).Offset(1)
            
        End With
        
    Next i

 

[RuinAerlin]

I think it's stuck in an endless loop somewhere after trying to run that. I've been waiting over half an hour.

 

[Norie]

Oops, my fault - the Offset(,6) should be for rngLook not rngFnd.

                Set rngLook = rngLook.Offset(, 6)
            Loop Until rngFnd Is Nothing

 

[RuinAerlin]

It's copying data in G:K repeatedly. Unfortunately I cannot follow your code to work out why this is happening. I like the premise of it though!

Aha that works perfectly thank you!!!