samwang

¦^´_ 1# john2006168


½Ð´ú¸Õ¬Ý¬Ý¡A ÁÂÁ¡C
Sub test()
Dim Arr, x%, FPath$, FD, FN, WB As Workbook, CT%, N%, M%
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
'========================================================================

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "D:\"
    .AllowMultiSelect = True
    .Show
    Tm = Timer
    For x = 1 To .SelectedItems.Count
        FPath = .SelectedItems(x)
        filedata = ActiveWorkbook.Name
        Set WB = Workbooks.Open(FPath)
        With Sheets(1)
            If .FilterMode Then .ShowAllData
            CT = Application.CountA([A1:A6636])
            If CT < 2 Then GoTo 99
            M = M + 1: FD = .[C1]
            Arr = .Range(.[K3], .[A65536].End(3))
            FN = Split(ActiveWorkbook.Name, ".")(0)
        End With
99:     WB.Close
        If M = 1 Then
            With Sheets("Summary")
                N = .Range("A65536").End(xlUp).Row + 1
                .Range("A" & N).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
                .Range("I" & N).Resize(UBound(Arr)) = FD
                .Range("K" & N).Resize(UBound(Arr)) = FN
            End With
            M = 0: Erase Arr
        End If
    Next
End With

'===========================================================================
Set WB = Nothing
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub

samwang

¦^´_ 4# john2006168

§ï¬°¦p¤U§Y¥i¡AÁÂÁ¡C
Arr = .Range(.[K13], .[A12].End(4))