返回列表 上一主題 發帖

資料彙總

回復 1# 蘿蔔泥

請測試看看,謝謝
Sub 匯總()
Dim Arr, x&, R%
Application.ScreenUpdating = False   '關閉螢幕更新
Application.DisplayAlerts = False
Sheets("總表").UsedRange.Offset(1, 0).Clear  '清除表頭之外的所有內容
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "D:\"
    .AllowMultiSelect = True
    .Title = "======= 選擇來源的檔案 ========"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    Tm = Timer
    For x = 1 To .SelectedItems.Count
        FPath = .SelectedItems(x)
        With Workbooks.Open(FPath)
            With Sheets(2)
                Arr = .Range("a6:h" & .[A65536].End(3).Row)
            End With
            .Close
        End With
        R = Sheets("總表").[d65536].End(xlUp).Row + 1
        Sheets("總表").Range("d" & R).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    Next
End With
MsgBox Timer - Tm & "秒"
Application.ScreenUpdating = True   '恢復螢幕更新
Application.DisplayAlerts = True
End Sub

TOP

        靜思自在 : 看別人不順眼,是自己修養不夠。
返回列表 上一主題