返回列表 上一主題 發帖

[發問] VBA 文件夾不同活頁簿複製到總表

[發問] VBA 文件夾不同活頁簿複製到總表

本帖最後由 john2006168 於 2021-5-25 10:50 編輯

如附件有1個文件夾有幾個workbook,想將資料複製到總表,請問老師可否提供方法學習(在不打開test01& test 02).[attach]33330[/attach][attach]33333[/attach]

擷取02.PNG (19.17 KB)

擷取02.PNG

擷取01.PNG (12.67 KB)

擷取01.PNG

Test.zip (41.04 KB)

回復 1# john2006168


請測試看看, 謝謝。
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

TOP

回復 2# samwang

這個非常實用,謝謝.

TOP

Test (2).zip (40.96 KB) 回復 2# samwang
老師你好,想問一下,如果我資料固定在第12列開始怎麼修改,因為資料上下面有些空格和文字.

TOP

回復 4# john2006168

改為如下即可,謝謝。
Arr = .Range(.[K13], .[A12].End(4))

TOP

回復 5# samwang


    感謝多次指導.

TOP

        靜思自在 : 要比誰更受誰.不要比誰更怕誰。
返回列表 上一主題