samwang

¦^´_ 1# stephenlee
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr(1 To 10000, 1 To 11), Crr(1 To 10000, 1 To 11)
Dim T$, T1$, n%, n1%, i%, j%, sh
T = Year(Date) & "-" & Month(Date)
For x = 4 To Sheets.Count
    sh = UCase(Left(Sheets(x).Name, 2))
    If InStr(sh, "QC") Then
        With Sheets(x)
            Arr = .Range("a1").CurrentRegion
            For i = 2 To UBound(Arr)
                T1 = Arr(i, 11): If Arr(i, 5) = 0 Then Exit For
                If T = T1 Then n = n + 1: For j = 1 To 11: Brr(n, j) = Arr(i, j): Next
            Next
        End With
    ElseIf InStr(sh, "CL") Then
        With Sheets(x)
            Arr = .Range("a1").CurrentRegion
            For i = 145 To UBound(Arr)
                T1 = Arr(i, 11): If Arr(i, 5) = 0 Then Exit For
                If T = T1 Then n1 = n1 + 1: For j = 1 To 11: Crr(n1, j) = Arr(i, j): Next
            Next
        End With
    End If
Next
If n > 0 Then
    With Sheets("QC Summary")
        .Range("a1").CurrentRegion.Offset(1, 0) = ClearContents
        .[a2].Resize(n, 11) = Brr
    End With
End If
If n1 > 0 Then
    With Sheets("CLS Summary")
        .Range("a1").CurrentRegion.Offset(1, 0) = ClearContents
        .[a2].Resize(n1, 11) = Crr
    End With
End If
End Sub