การค้นหาข้อมูลหลายชีตด้วย VBA

Sub SearchMultipleSheets()
    Dim arr(999, 4) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As String
    With Sheets(1)
        s = .Range("c1").Value
        .Range("a3").Resize(.UsedRange.Rows.Count, _
            .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
        If ws.Name <> Sheets(1).Name Then
            With ws
                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                    If r.Value & r.Offset(0, 1).Value & _
                        r.Offset(0, 2).Value & _
                        r.Offset(0, 3).Value Like "*" & s & "*" Then
                        arr(i, 0) = r.Value
                        arr(i, 1) = r.Offset(0, 1).Value
                        arr(i, 2) = r.Offset(0, 2).Value
                        arr(i, 3) = r.Offset(0, 3).Value
                        arr(i, 4) = ws.Name
                    End If
                Next r
            End With
        End If
    Next ws
    With Sheets(1)
        .Range("a3").Resize(i, 5).Value = arr
    End With
End Sub

Sub SearchMultipleSheets() Dim arr(999, 4) As Variant, r As Range Dim ws As Worksheet, i As Integer, s As String With Sheets(1) s = .Range("c1").Value .Range("a3").Resize(.UsedRange.Rows.Count, _ .UsedRange.Columns.Count).ClearContents End With For Each ws In Worksheets If ws.Name <> Sheets(1).Name Then With ws For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp)) If r.Value & r.Offset(0, 1).Value & _ r.Offset(0, 2).Value & _ r.Offset(0, 3).Value Like "*" & s & "*" Then arr(i, 0) = r.Value arr(i, 1) = r.Offset(0, 1).Value arr(i, 2) = r.Offset(0, 2).Value arr(i, 3) = r.Offset(0, 3).Value arr(i, 4) = ws.Name End If Next r End With End If Next ws With Sheets(1) .Range("a3").Resize(i, 5).Value = arr End With End Sub