将不同 Excel 中的数据复制到同一个文件夹中

Question

我想在 VBA 中编写一个代码，它将数据从不同的 Excel 表（都在一个文件夹中）复制到另一个 excel。 我尝试编写一个循环，遍历文件夹中的不同 excel，打开它们，复制一些内容，然后将其粘贴到另一个 excel 工作簿的末尾。对于最后一步，我将不得不使用“Dim last as long”，但我还没有。

没有缺陷说明，但宏不做任何事情。

我是 VBA 的新手，非常感谢任何建议！

 Sub copypaste()
    Dim strFileName As String
    Dim strFolder As String: strFolder = "L:....xlsx"
    Dim strFileSpec As String: strFileSpec = strFolder & "*.xlsx"
    strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("strFileSpec")
Set y = Workbooks.Open("L:....xlsx")
'Now, transfer values from x to y:
y.Sheets("aaa").Range("C2:BI8").Value = x.Sheets("bbb").Range("A5:BG10")
x.Close
    strFileName = Dir
Loop
End Sub

Answer 1

如果您的Do 循环正在执行，您的代码将引发一些错误。既然不是，我认为您的循环没有执行，您应该在此处询问之前对其进行验证。如果您不知道如何调试，请阅读 Chip Pearson 关于如何调试 VBA 的出色而简短的教程：

http://www.cpearson.com/excel/DebuggingVBA.aspx

如果您的Do 循环没有执行，那么您的文件夹/文件名和/或DIR 函数的实现存在问题。

strFolder 例如看起来很可疑，因为"L:....xlsx" 看起来不像是一个有效的文件夹路径。

Dim strFolder As String: strFolder = "L:....xlsx"

这是另一个问题。这一行指示 Excel 打开一个名为“strFileSpec”的工作簿（在活动目录中），这是一个字符串文字，而不是类似标识符的变量：strFileSpec。因为这一行没有引发错误，所以问题很可能如上所示（循环未执行），但 this 也是您需要修复的问题：

Set x = Workbooks.Open("strFileSpec")

应该是：

Set x = Workbooks.Open(strFileName)

它应该是strFileName（Dir 函数的结果），因为那是您复制/粘贴的来源。

此外，您可能应该在循环之外打开 y，并确保它是一个有效的文件名，但它目前不是：

Set y = Workbooks.Open("L:....xlsx")

所以，把所有这些放在一起，就是这样：

Sub copypaste()
    Dim x As Workbook
    Dim y As Workbook
    Dim strFileName As String
    Dim strFolder As String
    Dim strFileSpec As String

    Set y = Workbooks.Open("c:\users\your_name\desktop\file.xlsx") '<< This should be the file path of the file you're copying TO.

    strFolder = "c:\users\your_name\desktop\" '<< make sure this is a valid path to a FOLDER
    strFileSpec = strFolder & "*.xlsx"
    strFileName = Dir(strFileSpec)

    Do While Len(strFileName) > 0
        Set x = Workbooks.Open("strFileSpec")

        'Now, transfer values from x to y:
        y.Sheets("aaa").Range("C2:BI8").Value = x.Sheets("bbb").Range("A5:BG10")
        x.Close
        strFileName = Dir
    Loop
End Sub

注意上面只是覆盖了相同的范围目标，您需要确保每次循环迭代都写入不同的目标，例如：

    Dim i as Long

    Do While Len(strFileName) > 0
        Set x = Workbooks.Open("strFileSpec")

        'Now, transfer values from x to y:
        With x.Sheets("bbb").Range("A5:BG10")
            y.Sheets("aaa").Range("C2").Resize(.Rows.Count, .Columns.Count).Offset(i).Value = .Value
            i = i + .Rows.Count + 1
        End With
        x.Close
        strFileName = Dir
    Loop