Macro

Have you still got the Function in there?

Option explicit
Sub PrepareUpload()
    Dim ws     As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Journal"    'do nothing
            Case Else
                Find_Range("Yes", Range("W13:W100")).EntireRow.Select
                Selection.Copy Worksheets("Journal").Cells(Rows.Count, 1).End(xlUp)
        End Select
    Next ws
End Sub
Function Find_Range(Find_Item As Variant, _
                    Search_Range As Range, _
                    Optional LookIn As Variant, _
                    Optional LookAt As Variant, _
                    Optional MatchCase As Boolean) As Range

    Dim c      As Range
    If IsMissing(LookIn) Then LookIn = xlValues    'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart    'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False

    With Search_Range
        Set c = .Find( _
                What:=Find_Item, _
                LookIn:=LookIn, _
                LookAt:=LookAt, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=MatchCase, _
                SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With

End Function

Aaron doesn't use Option Explicit, so you need to place

Dim FirstAddress as String

in the Function or remove Option Explicit.

Function Find_Range(Find_Item As Variant, _
                    Search_Range As Range, _
                    Optional LookIn As Variant, _
                    Optional LookAt As Variant, _
                    Optional MatchCase As Boolean) As Range

    Dim c      As Range
    Dim firstAddress As String
 'etc

If it isn't finding any Rows it errors. This seems to work

Sub PrepareUpload()
    Dim ws     As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Application.ScreenUpdating = False
        On Error Resume Next
        Select Case ws.Name
            Case "Journal"    'do nothing
            Case Else
                ws.Select
                Find_Range("Yes", ws.Range("W13:W100")).EntireRow.Select
                Selection.Copy Worksheets("Journal").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End Select
    Next ws
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

That's relief(LOL). Glad we worked it out.