Nested Loop problem/Algorithm

I am comparing two columns from different sheets in the same workbook. If a match is found, I want to copy the data and paste it to a different sheet in the same workbook. But there are certain conditions that I have to account for when I perform copying and pasting


Please open my workbook in attachments and have a look at it


1)I want to first go to sheet1, pick an entry from columnB and then compare that entry with the entries of column B in the connections Sheet.

2)When it hits the First match, I want to copy the matched row and copy all rows till string "Name" appears in column A of the connection Sheet

3)Paste the copied data on to the sheet 2

4)Now I want to check if the value of the cell in column B of sheet connection contains a string which is present in the current entry of column B of sheet 1

5)if it does then copy everything till next Name in column A(this step continues until condition 6 gets true)

6)If not then the go back to Step 1


I am not a computer programmer, but I have tried writing a code after reading posts on the forum. I am anxiously looking for all of your replies

Sub SearchForString()

    Dim i As Integer
    Dim k As Integer
    Dim j As Integer
    
    i = 1

    k = 1
     
    j = 1
    
    Sheets("Sheet1").Select
    



'For j = 1 To ActiveSheet.Range("B").Value (This doesnt work :( )



Do While Sheets("connections").Range("B" & CStr(i)).Value = Sheets("Sheet1").Range("B" & CStr(j)).Value Or InStr(Sheets("connections").Range("B" & CStr(i)).Value, Sheets("Sheet1").Range("B" & CStr(j)).Value)
  
   Sheets("connections").Select
        
        Rows(CStr(i) & ":" & CStr(i)).Select
            
        Selection.Copy
            
            'Paste row into Sheet1 in next row
   
           Sheets("Sheet2").Select
       
            Rows(CStr(k) & ":" & CStr(k)).Select
            ActiveSheet.Paste
            
           ' Move counter to next row
    k = k + 1
    i = i + 1
    Sheets("connections").Select

Loop


Do
    Sheets("connections").Select
        
        Rows(CStr(i) & ":" & CStr(i)).Select
            
        Selection.Copy
           Sheets("Sheet2").Select
       
            Rows(CStr(k) & ":" & CStr(k)).Select
            ActiveSheet.Paste
            
        
    k = k + 1
    i = i + 1
    Sheets("connections").Select

 
 Loop Until InStr(Sheets("connections").Range("A" & CStr(i)).Value, "Name")



MsgBox j





'Next



End Sub