'6，多工作表提取指定数据（数组）

'http://excel.aa.topzj.com/viewthread.php?tid=399457&pid=73718&page=1&_

extra=#pid73718

Sub fpkf()

Application.ScreenUpdating = False

    Dim Myr&, Arr, yf,x&, Myr1&, r1

    Dim Sht As Worksheet

    Myr =Sheet1.[b65536].End(xlUp).Row

   Sheet1.Range("c8:h" & Myr).ClearContents

    Arr =Sheet1.Range("c8:h" & Myr)

    [j8].Formula ="=rc[-9]&""|""&rc[-8]"

    [j8].AutoFillRange("j8:j" & Myr)

    Range("j8:j"& Myr) = Range("j8:j" & Myr).Value

    For Each Sht In Sheets

       If Sht.Name <> Sheet1.Name Then

           yf = Left(Sht.Name, Len(Sht.Name) - 2)

           Sht.Activate

           Myr1 = [a65536].End(xlUp).Row - 1

           For x = 7 To Myr1

               If Cells(x, 1) <> ""Then

                   Set r1 = Sheet1.Range("j:j").Find(Cells(x, 1) & "|"& Cells(x, 2))

                   If Not r1 Is Nothing Then

                       Arr(r1.Row - 7, yf) = Cells(x, "ar")

                   End If

               End If

           Next x

       End If

    Next

    Sheet1.Activate[c8].Resize(UBound(Arr), UBound(Arr, 2)) = Arr

    [j:j].Clear

Application.ScreenUpdating = True

End Sub