VBA to Find Specific Text, then Copy range to next open cell under specific text

[Remotruker]

I'm looking to copy specific text from R5:AC5 to the first blank cell in column B after matching the text in R5 with text in column B

R5=Apples

B1= "Apples"
B2= Random alphanumeric
B3= Random alphanumeric
B4= Blank
B5= Random alphanumeric

R5:AC5- various alphanumeric text.
This would be copied into B4 since it is blank.


Thanks!

[davesexcel]

Attaching a sample workbook enables others to work on your problem:

To attach a sample workbook. Make sure there is just enough data to make it clear what is needed. Include BEFORE/AFTER sheets if needed to show the process you're trying to complete or automate. Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

[Remotruker]

I was able to hack together a solution:

Sub Copy_Schedule_Line()
    
      Range("S5:AC5").Select
    Selection.Copy
    
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("R5").Value
        If Trim(FindString) <> "" Then
        With Range("A:B")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If

If IsEmpty(ActiveCell.Offset(1)) Then
   ActiveCell.Offset(1).Select
Else
   ActiveCell.End(xlDown).Offset(1).Select
End If

    ActiveSheet.Paste
    Range("R5:AC5").Select
    Selection.Delete Shift:=xlUp
    Range("R5").Select
    Application.CutCopyMode = False
Range("A1").Select

End Sub