CODEWITHSUNDEEP
vbaexcel
VBAnoob
VBAnoob

Reputation: 163

Find a string, take the data under it and enter it into another worksheet

I want a to make some code that searches all the worksheets for the string "Question" then take "5" lines below it. Then take those 5 lines and put them in the worksheet "Template" from lines "B2".

Here is my current code:

    Dim SearchString As String
    Dim SearchRange As Range, cl As Range
    Dim FirstFound As String
    Dim sh As Worksheet
    ' Set Search value
    SearchString = "Question"
    Application.FindFormat.Clear
    ' loop through all sheets
    For Each sh In ActiveWorkbook.Worksheets
        ' Find first instance on sheet
        Set cl = sh.Cells.Find(What:=SearchString, _
            After:=sh.Cells(1, 1), _
            LookIn:=xlValues, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False)
        If Not cl Is Nothing Then
            ' if found, remember location
            FirstFound = cl.Address
            ' format found cell
            Do
                cl.Font.Bold = True
                cl.Interior.ColorIndex = 3
                ' find next instance
                Set cl = sh.Cells.FindNext(After:=cl)
            Loop Until FirstFound = cl.Address
        End If
    Next

All this code does is find the string. How do I take the data below the string and copy them to "Template" worksheet?

Upvotes: 1

Views: 57

Answers (1)

Chrismas007
Chrismas007

Reputation: 6105

You will want to invest in the .Offset Method:

Dim RangeToCopy As Range, DestRow As Long
Set RangeToCopy = sh.Range(cl.Offset(1, 0), cl.Offset(5, 0))
RangeToCopy.Copy
DestRow = Sheets("Template").Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("Template").Range("B" & DestRow).PasteSpecial xlPasteValues

Upvotes: 1

Related Questions