首页 文章

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

提问于
浏览 次
0

我想将工作簿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

这段代码几乎是正确的，但正如我之前所说，它将行复制到行而不是列复制到列 . 如何修改它来处理列？

excel vba excel-vba

1 回答

  • 0

    Sample Code Review

    要有效地修改您在线找到的代码，您必须首先了解它正在做什么 .

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

    • 获取我们想要的数据

    • 在我们的摘要表中打印，从 NRow 开始

    • 将 NRow 增加到当前数据的最后一行（以便下一组在正确的位置开始）

    What do we have to do?

    在我们的应用程序中，我们希望使 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 ） .

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

    回复于

相关问题