find and copy paste the value below found word

Hello emina002,

This macro will search "Sheet1" for the string "1234". If Found then the cells below the cell unitl the last entry in that column will be copied to "Sheet2" starting in cell "A1". You can change the sheet names and search word to what you need. Copy and paste this code into a new VBA module in your workbook.

NOTE: This searches for a whole words and case is ignored. If you need to look for a partial match then change xlWhole to xlPart in the SetMatch statement.

Sub CopyDataBelowWord()

  Dim DstRange As Range
  Dim Match As Range
  Dim Rng As Range
  Dim SrcWks As Worksheet
  Dim Word As String
  
    Word = "1234"
    Set SrcWks = Worksheets("Sheet1")
    Set DstRng = Worksheets("Sheet2").Range("A1")
    
      Set Match = SrcWks.Cells.Find(Word, , xlValues, xlWhole, xlByRows, xlNext, False)
     
      If Not Match Is Nothing Then
         Set Rng = SrcWks.Range(Match.Offset(1, 0), SrcWks.Cells(Rows.Count, Match.Column).End(xlUp))
         Rng.Copy DstRng
      End If
       
End Sub