Question

我想将工作簿1的工作表X（直到工作簿100）和A列从相同工作簿的工作表Y复制到新工作簿或打开和清空的工作簿。工作表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

示例代码审核

要有效地修改您在网上找到的代码，您必须先了解它在做什么。

简而言之，我们正在迭代每个工作簿并在循环中执行以下任务：

获取我们想要的数据
在我们的摘要表中打印，从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引用要开始的列而不是行。我建议使用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。）

注意：我在此处撰写的代码片段仅用于演示目的。它们尚未经过测试，不能简单地复制并粘贴到您的应用程序中。

如何将多个工作簿中的特定工作表中的列合并或复制到新工作簿？

1 个答案: