如何实现从多个文件里把相同的某一个字段中的一些值对应的某些字段，挑出来另存到....

Sub test1()
Dim lColor As Long
Dim w As Long
Dim i, r, j As Integer
Dim ar(2, 100)
Dim sht As Worksheet
w = 16777215

Set sht = Sheets("20160404")
r = sht.Cells(Rows.Count, 1).End(xlUp).Row
  j = 1
ar(0, 0) = "UserName"
ar(1, 0) = Mid(ActiveWorkbook.Name, 1, InStr(ActiveWorkbook.Name, ".") - 1)

For i = 1 To r
lColor = sht.Range("a" & i).Interior.Color
  If lColor <> w Then
  ar(0, j) = sht.Range("b" & i).Value
  ar(1, j) = sht.Range("c" & i).Value
  j = j + 1
  End If
Next
Sheets("结果").Range("a1:zz2").ClearContents
Sheets("结果").Range("a1").Resize(2, 100).Value = ar
Sheets("结果").Activate

End Sub