如何將列從多個工作簿中的特定工作表合並或復制到新工作簿？

Question

我想將工作簿1的工作表X中的A列（直到工作簿100）和同一工作簿的工作表Y中的A列復制到新工作簿或打開的空白工作簿中。 工作表X中的列應復制到特定工作表Xmerge的A列中，工作表Y中的列應復制到新工作簿中特定工作表Ymerge的A列中。 應該將其他復制的列從左到右分別插入到A列，然后是B，C等列。

由於必須考慮很多工作簿，因此我想使用VBA宏來自動化此過程。

詳細信息：所有工作簿都在一個文件夾中。 不同列中的已填充單元數量不相等，並且某些單元可以不包含任何數據或錯誤數據。 我使用Excel 2010。

不幸的是，我嘗試修改以下宏代碼以適合我的需要，但沒有成功。 （來源： https : //msdn.microsoft.com/zh-cn/library/office/gg549168 ( v=office.14 ) .aspx ）

此宏將行復制到行，而不是列復制到列。 因此，我想對此宏進行一些更改可以解決該問題。 但是，無論使用哪個宏，我都將感謝您提供的所有幫助。

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

' Create a new workbook and set a variable to the first sheet. 
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Peter\invoices\"

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")

' Loop until Dir returns an empty string.
Do While FileName <> ""
    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & FileName)

    ' Set the cell in column A to be the file name.
    SummarySheet.Range("A" & NRow).Value = FileName

    ' Set the source range to be A9 through C9.
    ' Modify this range for your workbooks. 
    ' It can span multiple rows.
    Set SourceRange = WorkBk.Worksheets(1).Range("A9:C9")

    ' Set the destination range to start at column B and 
    ' be the same size as the source range.
    Set DestRange = SummarySheet.Range("B" & NRow)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
       SourceRange.Columns.Count)

    ' Copy over the values from the source to the destination.
    DestRange.Value = SourceRange.Value

    ' Increase NRow so that we know where to copy data next.
    NRow = NRow + DestRange.Rows.Count

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    FileName = Dir()
Loop

' Call AutoFit on the destination sheet so that all 
' data is readable.
SummarySheet.Columns.AutoFit
End Sub

這段代碼幾乎是正確的，但是正如我之前說的，它是將行復制到行而不是將列復制到列。 如何修改它以處理列？

Answer 1

樣例代碼審查

為了有效地修改您在網上找到的代碼，您必須首先了解它在做什么。

簡而言之，我們遍歷每個工作簿並在循環中執行以下任務：

1. 獲取我們想要的數據
2. 從NRow開始在我們的摘要表中打印它
3. 將NRow增加到當前數據的最后一行（以便下一組從正確的位置開始）

我們該做什么？

在我們的應用程序中，我們要使NRow引用一列，以便下一個數據顯示在右側而不是下一個數據。 然后，當我們增加NRow ，我們需要它來計算目標中的列數而不是行數。 因此，必須對發生NRow的以下行進行NRow ：

SummarySheet.Range("A" & NRow).Value = FileName

Set DestRange = SummarySheet.Range("B" & NRow)

NRow = NRow + DestRange.Rows.Count

我們的首要任務是將NRow重命名為NCol或更合適的名稱，因為它不再計算行數。

接下來，讓我們的新變量NCol引用NCol的列而不是該行。 我建議使用“ Cells功能來輔助此操作。 Cells允許我們使用索引號來引用單元格，例如Cells(1,2)而不是Range("A2")這樣的字符串。

SummarySheet.Cells(1, NCol) = FileName ' Prints the fileName in the first row

Set DestRange = SummarySheet.Cells(2, NCol) ' Data starts in second row

現在剩下要做的就是根據找到的列數而不是行數來增加NCol 。

NCol = NCol + DestRange.Columns.Count

通過使行保持靜態並將NCol作為列，然后基於列數遞增NCol ，我們的數據將順序打印在右側，而不是向下打印。

正如您粘貼的示例代碼所說，您可能必須確定要從SourceSheet中獲取的范圍大小才能滿足您的需求。 上面的代碼盲目使用A9:C9您將需要更改它以引用源中的適當范圍（如果要在A列中的前12行，請參考A1:A12 ）。

注意：我在這里編寫的代碼段僅用於說明目的。 它們未經測試，也不能簡單地復制並粘貼到您的應用程序中。