VBA Help with copy Specific Cells to another Sheet

[DJMXM]

Hello All - I am working on the next part of my Monster and I am starting to build a VBA Module to copy over data from one sheet to another based on choices. I got a good part of it working but I need to copy one set of choices from a specific area of the sheet and add them to the list that already exists in the 2nd sheet. I am posting the code below. What I need help with is, I only need to look at data in Rows 81:85 and if TRUE in Column AI then I need to copy only cells AB, AC, AF, AG. I hope I am making sense. The code below works but copies everything that is true from column "AI" and I only need to look at rows 81:85 - I hope you can help.

Mike

Sub BEOLiquorManualList()

    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim FoundX As Range, Firstfound As String, Lastrow As Long
    
    Set wsSource = Worksheets("Catering and Rental Worksheet")     ' Source worksheet
    Set wsDest = Worksheets("Catering BEO")       ' Destination worksheet
    
    Set FoundX = wsSource.Range("AI:AI").Find("TRUE", After:=wsSource.Range("AI" & Rows.Count), _
                                 LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    
    If FoundX Is Nothing Then
        
        Exit Sub
        
    Else
        
        
        Firstfound = FoundX.Address
        
        Lastrow = wsDest.Range("G" & Rows.Count).End(xlUp).Row + 1
        If Lastrow < 3 Then Lastrow = 3
        
        Do
            
            ' Need to Copy from Only rows 81:85 and I only need columns (AB, AC, AF & AG) '
            
            wsDest.Range("G" & Lastrow).Resize(1, 4).Value = FoundX.Offset(0, -5).Resize(1, 4).Value
            
            Lastrow = Lastrow + 1
            
            Set FoundX = wsSource.Range("AI:AI").FindNext(FoundX)
            
        Loop Until FoundX.Address = Firstfound
    
    End If

End Sub

 

[JLGWhiz]

Just make the modifications in red:

Set FoundX = wsSource.Range("AI[COLOR=#b22222]81[/COLOR]:AI[COLOR=#b22222]85[/COLOR]").Find("TRUE", After:=wsSource.Range("AI[COLOR=#b22222]80[/COLOR]"), _
                                 LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)

 

[DJMXM]

That worked great.... I forgot to remove '& Rows.Count' From the end of that line.... Now the only thing I need to do is pick only certain cells in those rows to copy over.

 

[Teeroy]

Try replacing:

wsDest.Range("G" & Lastrow).Resize(1, 4).Value = FoundX.Offset(0, -5).Resize(1, 4).Value

with

wsDest.Range("G" & Lastrow).Resize(1, 2).Value = FoundX.Offset(0, -7).Resize(1, 2).Value
wsDest.Range("I" & Lastrow).Resize(1, 2).Value = FoundX.Offset(0, -3).Resize(1, 2).Value

 

[DJMXM]

Thank You - That worked great.... I am still learning VBA by the old fashion (Trial and Error) Method.