將范圍從文件夾中的多個工作簿復制到文件夾中的摘要工作簿嗎？

Question

我有一個包含100多個工作簿的文件夾。 這些工作簿包含一系列數據。 為簡單起見，我將數據范圍稱為A1：D2，該范圍位於所有100多個工作簿的Sheet1上。

我也有一個摘要工作簿。

我想將VBA代碼放在“摘要”工作簿中，該工作簿將遍歷該文件夾，並復制100多個工作簿中每個工作簿的范圍A1：D2。

然后，我想將每個工作簿的A1：D2范圍粘貼到“摘要”工作簿的Sheet1中。 每個粘貼將從下一個未使用的行開始。

我現在只能通過手動程序來執行此操作，這讓我發瘋。

我確實知道一些基本的VBA編碼，但是我的問題是我無法弄清楚如何正確地對其進行循環，因此我不得不對每個工作簿進行編碼以打開->復制->粘貼->關閉。 用10到20個工作簿就可以了，但是現在我已經100多歲了，而且每周都在增長。

再次感謝，

布賴恩

Answer 1

如果要復制多個工作簿，我有完全可以滿足您要求的東西，我建議創建一個新的工作表以將工作簿信息捕獲到電子表格中。 以下說明

1. 創建一個新的工作表並為其命名，在這種情況下，我們將其稱為“控件”

2. 在VBA中創建一個新模塊，並使用下面的代碼來操作工作簿副本

我為您留出了一部分，以編寫您要執行的功能的代碼。

子WorkbookConsolidator（）

Dim WB As Workbook, wb1 as workbook
Dim WBName as Range 
Dim folderselect as Variant, wbA as Variant, wbB as Variant, 
Dim I as long, J as long
Dim objFolder As Object, objFile As Object
Dim WBRange as String

'Set Core Variables and Open Folder containing workbooks.

 Set WB = ThisWorkbook
 Worksheets("Control").Activate
 Set FolderSelect = Application.FileDialog(msoFileDialogFolderPicker)
 FolderSelect.AllowMultiSelect = False
 MsgBox ("Please Select the Folder containing your Workbooks")
 FolderSelect.Show
 WBRange = FolderSelect.SelectedItems(1)
 Set objFolder = objFSO.GetFolder(FolderSelect.SelectedItems(1))


' Fill out File name Fields in Control Sheet 
' The workbook names will be captured in Column B
' This allows allocation for up to 100 workbooks
For I = 1 To 100
    For Each objFile In objFolder.files
    If objFile = "" Then Exit For
       Cells(I, 2) = objFile.Name ' Workbook Name
       Cells(I, 3) = WBRange ' Workbook Path
       I = I + 1
       Next objFile
    Next I

'Loop through the list of workbooks created in the 'Control' Directory, adjust the loop range as preferred
For J = 100 To 1 Step -1
      With Workbooks(ThisWorkbook).Worksheets("Control")
         BookLocation = .Range("C" & J).Value
         BookName = .Range("B" & J).Value
      End With

    Set wb1 = Workbooks.Open(Booklocation & Bookname)

    ' Write your code here'



       CleanUp:
       wb1.Close SaveChanges:=False

Next J

End Sub()

`

Answer 2

嘗試這個

Sub combine_into_one()
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim strPath$, Pivot$, sUserName$, sFolderName$, sSourceName$, x&
Dim oFldialog As FileDialog
Dim oFile As Scripting.File
Dim oFolder

Set oFldialog = Application.FileDialog(msoFileDialogFolderPicker)

With oFldialog
    If .Show = -1 Then
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        sFolderName = .SelectedItems(1)
    End If
End With

Set oFolder = FSO.GetFolder(sFolderName)

Workbooks.Add: Pivot = ActiveWorkbook.Name 'Destination workbook

For Each oFile In oFolder.Files
    Workbooks(Pivot).Activate

    x = Workbooks(Pivot).Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Workbooks.Open filename:=oFile: sSourceName = ActiveWorkbook.Name
    Workbooks(sSourceName).Activate
        Workbooks(sSourceName).Sheets("Sheet1").[A1:D1].Copy

    Workbooks(Pivot).Activate
    Workbooks(Pivot).Sheets("Sheet1").Cells(x, 1).PasteSpecial xlPasteAll
    Workbooks(sSourceName).Close False
Next

End Sub