VBA 将数据从多个工作簿传输到主工作簿时遇到问题

Trouble with VBA to transfer data from multiple workbooks to master workbook

我正在使用 Excel 2013 并尝试使用教程 Transfer to Master from Multiple Workbooks 中的以下代码将多个工作簿中的数据运行转移到主工作簿中。它将多个 wkbk 中的数据添加到主 wkbk 中,每次都将数据粘贴在其上方的数据下方,而不是在主 wkbk 中的单独电子表格上。

我根据教程将代码放入 MASTER 工作簿中,但没有任何反应。我不太了解VBA。我刚刚学会了如何休息和 运行 代码,但这并没有真正告诉我任何事情,我不认为。

  1. 我的桌面上有一个名为 'merge' 的文件夹,其中包含一个名为 MASTER 的启用宏的 wkbk,另外 3 个 non-macro wkbk 名为 tblScheduleMergeTWO、tblScheduleMergeTHREE 和 tblScheduleMergeFOUR。
  2. 每个 wkbk,包括 MASTER,都有 9 列具有相同的字段标题,我认为这与此代码无关。
  3. 我需要从中复制的 3 个 wkbks 在数据上有不同的阴影,因此当它粘贴到 MASTER 时我可以分辨出哪些数据来自哪个 wkbks。

我的尝试:海报的编辑 -

  1. 我打开 MASTER wkbk 并将光标放在那个 wkbk 中,运行 从那里输入代码。

  2. 我已经用我需要从打开复制的其他 wkbks 之一尝试过,并在关闭时尝试过它,屏幕有时会闪烁一次,但在复制任何数据方面没有任何反应。

  3. 根据@Tony Dallimore 的建议,在 ActiveSheet.Paste Destination: 之后和 Loop Application.DisplayAlerts = True 之后移动 Active.Workbook.Close 并且它没有改变任何东西。我不确定它是否会擦除任何内容以关闭 wkbk,但他会知道得更多。

  4. 根据#Tony Dallimore 的建议,单独将 Cells(erow, 9) 更改为 Cells(erow, lastcolumn),并与其他编辑一起更改,没有任何更改。

  5. 不明白#Tony Dallimore 的第三条建议。是否要替换 Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy withSrcRange.Copy Destination:=DestTopLeftCell?我没看到它会覆盖 lastrow 到 lastcolumn。`

  6. 我也尝试了另一个教程,但它在 enter link description here 中也没有用。没有post代码节省空间。

10/1/19 11:19 AM Poster 的编辑 10. 根据@Thomas Inzina 的建议,我使用 F8 在他的代码中逐行排除故障,他 post编辑。我立即注意到使用 F8,当您单击 ThisWorkbook 或单击 Sheet1 时,代码 'With ThisWorkbook.Worksheets("Sheet1")' 的起始行在屏幕提示中显示为 FileName=""。貌似连ThisWorkbook都不认识,真叫MASTER.xlsm。这是怎么回事?但是,当您将光标悬停在 'Do While FileName <> ""' 上时,屏幕提示会显示文件名。然后当我按 F8 时,它会弹出一条消息,说你的主文件已经打开并且可能会损坏重新打开。当我 select 不,我不想让它再次打开时,我收到一条错误消息,询问我是否要结束或调试。如果我调试,则 'With Workbooks.Open(FolderPath & FileName)' 突出显示为问题。我只需要保存并关闭 Master wkbk,然后麻烦就消失了;但是,在 'With Workbooks.Open(FolderPath & FileName)' 之后按 F8 会跳过其余代码并返回到开头。在所有这一切中,我没有看到代码给出了一个屏幕提示,表明它注意到我需要从中复制的 wkbks。

非常感谢您的帮助。我也要检查这个 post Other post to t/f data from multiple wkbks

是不是 FileName = Dir 错了?

Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String
Dim FilePath As String
Dim FileName As String
'or Dim FolderPath As String, FilePath As String, FileName As String

FolderPath = "C:\Users\PC-1\Desktop\Merge\"
FilePath = FolderPath & "*.xls*"
FileName = Dir(FilePath)

'Don't know how many rows of data so define last row and column
Dim lastrow As Long
Dim lastcolumn As Long
'will use in a loop as number columns and rows from which extract data

Do While FileName <> ""
Workbooks.Open (FolderPath & FileName)

'Assign value to last row
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlLeft).Column

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
'to disable alerts that you have a lot of data copied to clipboard, etc.
Active.Workbook.Close

'when go back to master to paste, we need to know which is next blank row to paste data
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
'Offset to go to next row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 9))

FileName = Dir

Loop
Application.DisplayAlerts = True



End Sub

2016 年 10 月 2 日海报编辑 - 回应 Tony Dallimore - 托尼,我通读了代码,但认为我已经足够理解 运行 它并看看会发生什么(但是,我将更深入地研究它并重新输入);但是,当我尝试 运行 它时,什么也没有发生。我是否应该将我的工作簿名称或任何工作表名称(例如:WshtDestName)替换为代码?

我收到一个 运行 时间错误 9 下标超出范围错误,当我调试它时,设置 WshtDest = WbkDest.Worksheets(WshtDestName) 被突出显示。

我想我可能应该用我的 MASTER.xlsm 文件中的 wksht 名称替换上面的 WshtDestName。因此,我将 "Sheet1" 放在括号中。没有错误消息,但也没有任何反应。

我想也许我应该用两个 wkbks 中我的 wksht 的名字替换 2 个常量 Const WshtDestName As String = "Data"Const WshtSrcName As String = "Data" 中的 "Data",所以我放了 "Sheet1" "Data" 所在的位置,再次,什么也没发生。

我不知道开头的常量是否应该在 Sub 之后,所以我将它们移到 Sub 下的 Dim 之后,然后什么也没发生。

当我按 F8 查看每一行代码时,屏幕提示如下:

我 运行 你的代码就像你输入的一样,除了我注释掉了你说要注释掉的部分(如果我确实有 headers 并且我取消了你说的部分的注释)取消评论。还是不行。

您可以直接复制到目标范围,完全避免使用剪贴板。

Sub copyDataFromMultipleWorkbooksIntoMaster()

    Dim FileName As String, FilePath As String, FolderPath As String
    Dim lastrow As Long, lastcolumn As Long
    Dim LastCell As Range

    With ThisWorkbook.Worksheets("Sheet1")
        Set LastCell = .Cells(.Rows.Count, 1)
    End With

    FolderPath = "C:\Users\PC-1\Desktop\Merge\"
    FilePath = FolderPath & "*.xls*"
    FileName = Dir(FilePath)

    Do While FileName <> ""
        With Workbooks.Open(FolderPath & FileName)

            'Assign value to last row
            lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastcolumn = .Cells(1, .Columns.Count).End(xlLeft).Column

            .Range("A2", .Cells(lastrow, lastcolumn)).Copy LastCell.End(xlUp).Offset(1)

            .Close False

        End With
        FileName = Dir

    Loop

End Sub

我已经设置了符合您描述的文件夹和工作簿。下面修改后的代码对我有用。我希望原始代码都是你的。我可以很容易地原谅新手的一些错误和不良做法,但如果你按照你的建议从教程中得到这个,我会感到震惊。

我已经添加了评论来解释我的所有更改。如有必要,请回来进行更多解释,但您自己破译我的代码越多,您的技能就会发展得越快。我包括说明代码在做什么的评论,但很少评论语句本身。例如,Option Explicit 一旦知道它存在就很容易查找,所以它的用途没有解释。

Option Explicit         ' Always have this statement at the top of every module

  ' Constants are fixed while a macro is running but can be changed
  ' if the data is redesigned. This defines the first data row of every
  ' worksheet is 2. That is, it allows for one header row. I could have used
  ' 2 within the code below. If you ever have to update code because the
  ' number of header rows has changed or a new column has been inserted in
  ' the middle of existing columns, you will understand why I use constants.
  Const RowDataFirst As Long = 2        ' Set to 1 if no header rows

  ' You assume that when you open a workbook, the active worksheet is the one
  ' required. This is only reliable if the workbooks only have one worksheet.
  ' I have defined one constant for the name of the worksheet within the
  ' destination workbook and one for name of the worksheet within every
  ' source workbook. I assume this is adequate. I will have alternative
  ' suggestions if it is not adequate.
  Const WshtDestName As String = "Data"
  Const WshtSrcName As String = "Data"
Sub copyDataFromMultipleWorkbooksIntoMaster()

  Dim FolderPath As String
  Dim FilePath As String
  Dim FileName As String
  Dim HeaderCopied As Boolean
  Dim RowDestNext As Long
  Dim RngDest As Range
  Dim RngSrc As Range
  Dim WbkDest As Workbook
  Dim WbkSrc As Workbook
  Dim WshtDest As Worksheet
  Dim WshtSrc As Worksheet

  Application.ScreenUpdating = False

  ' You need row numbers in both the source and the destination worksheets.
  ' Use names for variables that tell you exactly what the variable is for.
  ' While you are writing a macro, it is easy to remember odd names but if
  ' you return to the macro in six or twelve months will you still remember?
  ' I have a naming system which I always use. I can look at macros I wrote
  ' ten years ago and know what all the variable are which is an enormous help
  ' when updating old code. If you do not like my system then develop your own.
  ' My names consist of a series of keywords with the most global first.
  ' "Row" says the variable is a row number. "Wbk" says the variable is a
  ' workbook. "RowXxx" says the variable is a row number within worksheet or
  ' array Xxxx. "RowSrcXxx" says the variable is a row number for worksheet
  ' "Source". "Xxx" can be "First", "Crnt", "Next", Prev", "Last" or whatever
  ' I need for the current macro

  Dim RowSrcLast As Long

  ' My comment suggested you be consistent in your use of column numbers but
  ' comments do not allow enough room to explain. With some statements, having
  ' a different number of rows or columns in the source and destination can
  ' give funny results with truncation or duplication. If you know you only
  ' want 9 columns then use 9 in both source and destination ranges. If the
  ' number of columns might change then determine the number at runtime.
  Dim ColSrcLast As Long

  ' If you are handling multiple workbooks be explicit which workbook
  ' you are addressing.  This assumes the workbook into which the worksheets
  ' are collected is the workbook containing the macro.
  Set WbkDest = ThisWorkbook

  Set WshtDest = WbkDest.Worksheets(WshtDestName)
  ' Note a worksheet variable references the worksheet within its workbook.
  ' I do not need to write WbkDest.WshtDest.

  ' FolderPath = "C:\Users\PC-1\Desktop\Merge\"
  ' You can hard code the name of the folder into a macro but it is
  ' a bother when you move your workbooks. When all your workbooks
  ' are in the same folder, the following is more convenient
  FolderPath = WbkDest.Path & "\"

  FilePath = FolderPath & "*.xls*"

  ' Note Dir searches down the folder index for files that match the template.
  ' The sequence in which they are found depends on the sequence in which the
  ' files were added to the folder. There are other techniques if sequence is
  ' important.
  FileName = Dir$(FilePath)         ' Dir$ is marginally faster than Dir

  ' Your existing code adds new data to the end of the existing worksheet in
  ' Master.xlsm. This may be correct but it is more usual to clear the
  ' destination at the start of each run. Comment out the first block and uncomment
  ' the second block if you want to add to existing data.

  With WshtDest
    .Cells.EntireRow.Delete  ' Delete every row in worksheet
    HeaderCopied = False     ' There is no header within the destination worksheet
    RowDestNext = 1          ' First (only) header row will be copied from first
                             ' source worksheet to this row
  End With

  ' If you know that column A of the used rows of the active sheet contains no
  ' blank cells, the following is the easiest way of finding that last used row:
  '   RowDestLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  ' But this technique is unreliable if there might be blank cells. No technique
  ' is 100% reliable but you would have very strange data if the technique I have
  ' used is not reliable for you.

  'With WshtDest
  '  ' Find last row with a value
  '  Set RngDest = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
  '  If RngDest Is Nothing Then
  '    ' No data has been found so the worksheet is empty
  '    HeaderCopied = False     ' There is no header within the destination worksheet
  '    RowDestNext = 1          ' First (only) header row will be copied from first
  '                             ' source worksheet to this row
  '  Else
  '    ' There is data within the worksheet. Assume the header row(s) are present.
  '    HeaderCopied = True
  '    RowDestNext = RngDest.Row + 1
  '  End If
  'End With

  ' Please indent your code within Do-Loops, If, etc. It makes your code
  ' much easier to read.

  ' All your workbooks are within the same folder. Master.xlsm will be one
  ' of those found but you do not want to use it as a source workbook.

  Do While FileName <> ""
    If FileName <> WbkDest.Name Then
      Set WbkSrc = Workbooks.Open(FolderPath & FileName)

      ' WbkSrc will be the active workbook but better to reference it explicitly

      With WbkSrc
        Set WshtSrc = .Worksheets(WshtSrcName)
      End With

      With WshtSrc
        ' Find last row with data if any
        Set RngSrc = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
        If RngSrc Is Nothing Then
          ' No data has been found so the worksheet is empty
        Else
          RowSrcLast = RngSrc.Row
          ' Find last column with data. Already know there is data
          RngSrc = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
          ColSrcLast = RngSrc.Column

          If HeaderCopied Then
            ' Already have header row(s) in destination worksheet
            Set RngSrc = .Range(.Cells(RowDataFirst, 1), .Cells(RowSrcLast, ColSrcLast))
          Else
            ' Do not have header row(s) in destination worksheet. Include them in copy.
            Set RngSrc = .Range(.Cells(1, 1), .Cells(RowSrcLast, ColSrcLast))
            HeaderCopied = True
          End If
          RngSrc.Copy Destination:=WshtDest.Cells(RowDestNext, 1)  ' Copy data and formats
          RowDestNext = RowDestNext + RngSrc.Rows.Count            ' Step ready for next copy
        End If
      End With  ' WshtSrc

      WbkSrc.Close SaveChanges:=False
      Set WshtSrc = Nothing
      Set WbkSrc = Nothing

    End If  ' FileName <> WbkDest.Name

    FileName = Dir$

  Loop  ' While FileName <> "" And FileName <> WbkDest.Name

  With WshtDest
    .Cells.EntireColumn.AutoFit
  End With

  Application.ScreenUpdating = True

End Sub

响应 OP 对原始答案的评论的新部分

有些事情我真的应该包括在我原来的答案中,但你也误入了我无法预料的领域。您还发现了一个我自己的测试遗漏的错误。

“Was I supposed to substitute anything like my workbook(s) name …”

我应该说清楚的。在 Const WshtDestName As String = "Data" 中,“数据”是我收集数据的工作表的名称。我应该告诉你用你的工作表名称替换“数据”。

您的评论表明您已更换:

 Set WshtDest = WbkDest.Worksheets(WshtDestName)

 Set WshtDest = WbkDest.Worksheets("Sheet1")

如果是,请改为更新 Const 语句。使用 Const 语句的 objective 是为了将可能更改的内容与代码的主要 body 隔离开来。这使维护更容易。

避免使用默认名称“Sheet1”、“Sheet2”等。随着您的数据和宏变得越来越复杂,如果工作表名称反映了工作表内容,它会让生活变得更加轻松。

[来自 OP 的注释: 我将我的主 wksht 重命名为 'Combined' 并将我的源 wkshts 重命名为 'Node Export By Hub',并替换了 'Sheet1'在具有这些名称的常量中命名。]

我使用WbkDest.Name作为主工作簿的名称。您不需要将其更改为您的实际工作簿名称。使用这样的属性可以使您的代码更易于维护,因为如果您重命名工作簿,属性 值将会更改。

I received a Run Time Error 9 Subscript out of Range error and when I debugged it, Set WshtDest = WbkDest.Worksheets(WshtDestName) was highlighted.

这段文字可能超出了您目前的知识范围 VBA。阅读它并提取你能理解的内容。随着您前进到数组和 collections,它会变得更加清晰。 Worksheets 是一个 Collection 或大多数编程语言所说的列表。 collection 就像一个数组,只是您可以在中间添加新值并删除现有值。在数组中,条目只能通过索引号访问,例如:MyArray(5)。 collection 中的条目可通过索引访问,但 collection 条目也可以有 key。如果我写 Worksheets(5) 这会给出错误 9,因为没有工作表 5。当您 运行 宏时,WshtDestName 的值为“数据”。没有 Worksheets("Data"),所以你得到错误 9。如果你更新 Const 语句,这个错误将会消失,因为 Worksheets("Sheet1") 存在。

I didn't know if the constants at the beginning were supposed to be after the Sub so I moved them to be after the Dim's under Sub and nothing happened then.

这里你误入了"Scope"的话题。如果我在子例程或函数中声明常量或变量,则它仅在该子例程或函数中可见。常量或变量的“范围”是函数。如果我在模块的顶部声明一个常量或变量,它对该模块中的每个子例程或函数都是可见的,但对其他模块中的子例程或函数不可见。常量或变量的“范围”是模块。如果我在声明中添加“Public”,常量或变量对于工作簿中每个模块或用户窗体中的每个子例程或函数都是可见的。常量或变量的“范围”是工作簿。

[来自 OP 的注释: 这很有趣,因为我无法通过 Google 在 Sub 之前找到有关常量的信息。谢谢。]

此工作簿只有一个子例程和一个模块,没有用户表单,因此放置常量声明的位置并不重要。常量或变量的最合适范围是一个复杂的问题,我不打算尝试介绍。我只想说这些常数记录了我对工作簿的假设。如果有多个模块,我会将它们定义为 Public。

你需要检查我所有的假设。我没有你的数据。我编造了我认为与您的数据相符的数据。但是,如果我对您的数据的任何假设是错误的,宏将不起作用。

When I hit F8 to look at each line of code, here is what the screen tip says: For Application.ScreenUpdating = False it says Application.ScreenUpdating = True

当语句为黄色时,表示尚未执行。对于大多数语句,您实际上可以在再次按 F8 执行它之前对其进行修改。所以如果你有一个黄色的A = A + 2并且你认为:“我的意思是A = A + 3”,你可以在执行前更正语句。

TrueApplication.ScreenUpdating 的默认值,因此这是您在执行 Application.ScreenUpdating = False 之前看到的值。

For Set WbkDest = ThisWorkbook the screen tip says for WbkSet = Nothing and for ThisWorkbook = , but only says these things when yellow highlighted. When hit F8 and move off that line, it doesn't say anything when I put the cursor over it.

如果您将鼠标悬停在普通变量 (dattype = Long、String、Boolean 等),解释器将显示它的值。 object(例如 WbkDest)有很多属性;解释器应该显示哪个?某些 object,例如 Range,具有默认值 属性。对于 Range,这是 Value,所以如果您将鼠标悬停在 运行ge 上,您会看到该值。工作簿没有默认值 属性,因此解释器不显示任何内容。

转到即时 Window 并键入 ? WbkDest.Name 并单击 Enter。解释器将显示工作簿的名称。您可以获得显示的任何工作簿属性的值。也可以显示sub-properties,例如:WbkDest.Worksheets.CountWbkDest.Worksheets("Sheet1").Range("A1").Value.

[来自 OP 的注释:第一个错误 - 我收到 Run-time '424': Object required 当我输入 '? WbkDest.Name' 并在立即 Window 中按 Enter。是不是认不出WbkDest了,因为一开始声明的是Dim,后面是Set = This Workbook。我将 MASTER.xlsm 的名称更改为 MASTER_DESKTOP TEST.xlsm 但这无关紧要,因为我们从未在此代码中明确提及它,对吗?]

TD 对上述注释的回应 Dim X As Type 为 X 保留一些 space 并将其值设置为该类型的默认值。对于 Long 类型,该值将为零。对于类型 Object(工作簿是 Object 的 sub-type),默认值为 Nothing。 Nothing 没有任何属性,所以在这个阶段 ? WbkDest.Name 会报错。当执行语句 Set WbkDest = ThisWorkbook 时,WbkDest 现在可以访问 ThisWorkbookThisWorkbook 有一个 Name 所以 ? WbkDest.Name 会有一个值。你是对的;您可以在不更改代码的情况下重命名工作簿。

Set RngDest = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious) where RngDest = Nothing in tip and nothing pops up in screen tip except -4123 for xlFormulas, and 1 for xlByRows, and 2 for xlPrevious.

据此我推断您想将新数据添加到先前运行宏的数据底部。以我的经验,这是不寻常的,但为了以防万一,我包含了此选项的代码。

[来自 OP 的注释: 仅供参考,是的,Master 有 headers,数据将添加到先前通过宏复制的数据下方.]

TD 对上述说明的回应我的代码比您需要的更复杂,但包含您想要的功能。如果主工作表为空,header 行和数据行将从第一个源工作表中复制。只会从任何其他工作簿复制数据行。如果主工作表不为空,则仅从源工作表复制数据行。

xlFormulas、xlByRows 和 xlPrevious 是 Excel 定义的常量,因此 Find 的参数是有意义的名称而不是 st运行ge 数字。

根据列出的其他语句,我推断目标工作簿当前为空。

[来自 OP 的注释: 仅供参考,是的,Master/destination wkbk 在第一行有一个 header 行,但在其他方面是空的与.]

TD 对上述说明的回复请参阅我的最后回复。

Do While FileName <> "" And FileName <> WbkDest.Name where both FileName and WbkDest.Name = "MASTER.xlsm" in screen tip. F8 then jumps through the rest of the code to the end where With WshtDest .Cells.EntireColumn.AutoFit End With, etc.

此时你在我的代码中遇到了一个错误。不明白为什么我的测试没有遇到这个bug

你要问:为什么循环退出了?为什么没有重复下一个文件?如果我省略了大部分代码,你会得到:

Do While FileName <> "" And FileName <> WbkDest.Name
  ‘ Code to process interesting file
  FileName = Dir$
Loop  ' While FileName <> "" And FileName <> WbkDest.Name

FileName <> "" 为 True,因为 FileName =“MASTER.xlsm”,但 FileName <> WbkDest.Name 为 False,因为“MASTER.xlsm”= WbkDest.Name。已达到结束条件,循环结束而不检查任何其他文件。

我应该写:

Do While FileName <> ""
  If FileName <> WbkDest.Name
    ‘ Code to process interesting file
  End If
  FileName = Dir$
Loop  ' While FileName <> ""

使用此代码,根据需要忽略工作簿“MASTER.xlsm”,但循环继续寻找更多工作簿。

修改宏以匹配修改后的结构,然后重试。

[来自 OP 的注释:第二个错误 我收到一个编译错误 - 预期:Then 或 Go To,所以我只是在 If FileName <> WbkDest.Name 之后添加了 Then , 所以它显示为

If FileName <> WbkDest.Name Then
Set WbkSrc=Workbooks.Open (FolderPath & FileName)
'Rest of Code

这是正确的吗?]

TD 对上述注释的回应 是的,你是对的。我应该包含经过测试的代码,而不是尝试创建摘要。

[来自 OP 的注释:第三个错误 - 在我添加了所有编辑之后,我 运行 [=224= 下的编译 VBA 项目] 它说,编译错误:没有 Do 的循环,我不明白,因为我确定它指的是循环在底部并且旁边从来没有 'Do'。换句话说,我不确定为什么它现在从来没有 'Do'.]

时会引发错误

TD对上述注释的回应编译错误"Loop without Do"、"Do without Loop"、"If within End If"、"End If without If"等可以令人困惑。 Do 循环、for 循环和 Ifs 必须正确嵌套。如果您未能完全完成一个结构,编译器会抱怨可能是完美的外部结构。我猜,您是不是没有为新的 If 添加 End If。当编译器命中 Loop 时,它正在寻找 End If 或嵌套结构的开头。我已经用我刚刚再次测试过的修改后的代码替换了我的原始代码。你可以复制ne代码并更新您的姓名。但是,最好处理您的循环并将其与我的相匹配。我的猜测是您会在我的代码中发现您的代码中缺少的 End If