Macro for moving the columns

Hello, I created a macro for the purpose of checking whether there are columns with specific string my spreadsheet and in case there are, the macro should copy those columns into columns I-M. The problem is that my macro copy only the first value found into the entire column. Is there any way I could make it work? Thanks.

Code:

---

Sub Find()
    Dim rngFound As Range
    With Worksheets(3).Range("h:xy")
        Set rngFound = .Find(What:="Pos", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        Columns("i").Value = rngFound.Value
        Columns("j").Value = rngFound.Offset(0, 1).Value
        Columns("k").Value = rngFound.Offset(0, 2).Value
        Columns("l").Value = rngFound.Offset(0, 3).Value
        Columns("m").Value = rngFound.Offset(0, 4).Value
   
    End With End Sub

---

This might be helpful:

http://www.barnesandnoble.com/w/exce...ach/1101874584