VBA: find cell and loop through list from that cell and copy to another sheet

Viewed 23

What I am trying to accomplish:

  • Find cell corresponding value from sheet 1
  • Loop through a list of items up to the last one starting from one cell below the searched value
  • Copy the list to sheet 2

Here is my list of items:

BOMS

So what I am searching for is "BOMn" and trying to copy the list below to another sheet inside range A2:B10 (1st row is headers). Here is my code:

Sub copy_bom()

    Dim wb As Workbook
    
    Dim ws_boms As Worksheet
    Dim ws_project As Worksheet
    
    Set wb = ThisWorkbook
    Set ws_boms = wb.Sheets("Sheet1")
    Set ws_project = wb.Sheets("Sheet2")
    
    Dim rng As Range
    Dim cellFind As Range
    
    Dim lastRow As Long
    
    Set rng = ws_boms.Range("A1:A50")
    
        With rng
        
            Set cellFind = .Find(What:="BOM2", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            
            If Not cellFind Is Nothing Then
            
                For lastRow = cellFind.Row + 1 To Range("A" & Rows.Count).End(xlUp).Row
                
                    ws_project.Range("A10").End(xlUp).Offset(1, 0).Value = .Cells(lastRow, 1).Value
                    ws_project.Range("A10").End(xlUp).Offset(0, 1).Value = .Cells(lastRow, 2).Value
                    
                Next
                
            End If
            
        End With
        
End Sub

My problem is that the list "scrambles" and in the target sheet the order is completely wrong and some of the items are missing. Is there a clear reason for that behavior or a better way to accomplish what I am trying to do? Any help is appreciated!

0 Answers
Related