如何將多個工作簿中特定工作表中的列合併或複製到新工作簿？

Question

我想將工作簿1的工作表X（工作簿100）的工作表X中的A列和工作表Y中相同工作簿的A列複製到新的工作簿或打開的空工作簿。工作表X中的列應複製到特定工作表Xmerge的A列，而工作表Y中的列應轉到新工作簿中特定工作表Ymerge的A列。其他複製的列應該從左到右分別插入到列A和B，C等列。

由於有很多工作簿， VBA宏。

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

我試圖修改以下宏代碼以適合我的需要，但不幸沒有成功。 （來源：https://msdn.microsoft.com/en-us/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發生：

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

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

NRow = NRow + DestRange.Rows.Count 

我們的業務的第一順序應該是重命名NRow到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您將需要更改此參考源中的適當範圍（如A1:A12，如果您想要列A中的前12行）。

注意：我在這裏寫的代碼片段僅用於演示目的。他們沒有經過測試，不打算簡單地複製並粘貼到您的應用程序中。