我已经设置了一个与您的描述相匹配的文件夹和工作簿。下面修改后的代码对我有用。我希望原始代码是你的。我可以很容易地原谅新手的一些错误和不良做法,但如果你按照你的建议从教程中得到这个,我会感到震惊。
我已经包含评论来解释我的所有更改。如有必要,请回来寻求更多解释,但是您自己破译我的代码越多,您发展技能的速度就越快。我包括注释来说明代码在做什么,但很少有关于语句本身的注释。例如,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对原始答案的评论的新部分
有些东西我真的应该包含在我的原始答案中,但你也误入了我无法预料的领域。您还发现了一个我自己的测试遗漏的错误。
“我应该用我的工作簿名称替换任何东西吗……”</p>
我应该说清楚的。在Const WshtDestName As String = "Data"
中,“数据”是我在其中积累数据的工作表的名称。我应该告诉你在工作表中用你的名字替换“数据”。
您的评论表明您已替换:
Set WshtDest = WbkDest.Worksheets(WshtDestName)
和
Set WshtDest = WbkDest.Worksheets("Sheet1")
如果是这样,请Const
改为更新声明。使用Const
语句的目的是隔离代码主体中可能发生变化的事物。这使维护更容易。
避免使用默认名称“Sheet1”、“Sheet2”等。随着您的数据和宏变得越来越复杂,如果工作表名称反映工作表内容,它会使生活变得更加轻松。
[来自 OP 的注释:我将我的主 wksht 重命名为“Combined”,将源的 wkshts 重命名为“Node Export By Hub”,并将常量中的“Sheet1”名称替换为这些名称。]
我用WbkDest.Name
作主工作簿的名称。您无需将其更改为您的实际工作簿名称。使用这样的属性使您的代码更易于维护,因为如果您重命名工作簿,属性值将会改变。
我收到一个运行时错误 9 下标超出范围错误,当我调试它时,突出显示了 Set WshtDest = WbkDest.Worksheets(WshtDestName)。
本段可能超出您目前对 VBA 的了解。阅读并提取你能理解的内容。随着您进入数组和集合,它会变得更加清晰。 Worksheets
是一个Collection
或大多数编程语言称之为列表。集合就像一个数组,只是您可以在中间添加新值并删除现有值。在数组中,条目只能通过索引号访问,例如:MyArray(5)
. 集合中的条目可以通过索引访问,但集合条目也可以有一个key
. 如果我写Worksheets(5)
了这将给出错误 9,因为没有工作表 5。当你运行宏时,WshtDestName
有一个值“数据”。没有Worksheets("Data")
,所以你得到了错误 9。如果你更新Const
语句,这个错误将会消失,因为Worksheets("Sheet1")
存在。
我不知道一开始的常量是否应该在 Sub 之后,所以我将它们移动到 Dim 在 Sub 之后,然后什么也没发生。
在这里,您误入了“范围”的主题。如果我在子例程或函数中声明常量或变量,则它仅在该子例程或函数中可见。常量或变量的“作用域”就是函数。如果我在模块顶部声明一个常量或变量,则该模块中的每个子例程或函数都可以看到它,但其他模块中的子例程或函数不可见。常量或变量的“范围”是模块。如果我在声明中添加“Public”,则常量或变量对工作簿中每个模块或用户表单中的每个子例程或函数都是可见的。常量或变量的“范围”是工作簿。
[来自 OP 的注释:这很有趣,因为我无法通过 Google 在 Sub 之前找到有关常量的信息。谢谢。]
该工作簿只有一个子例程和一个模块,没有用户表单,因此放置常量声明的位置并不重要。常量或变量的最合适范围是一个复杂的问题,我不打算尝试介绍。我只想说这些常数记录了我对工作簿的假设。如果有多个模块,我会将它们定义为 Public。
你需要检查我所有的假设。我没有你的数据。我已经编造了我认为与您的数据相匹配的数据。但是,如果我对您的数据的任何假设是错误的,那么宏将不起作用。
当我按 F8 查看每一行代码时,屏幕提示如下:因为Application.ScreenUpdating = False
它说Application.ScreenUpdating = True
当一个语句为黄色时,它还没有被执行。对于大多数语句,您实际上可以在F8再次按下执行它之前对其进行修改。因此,如果您有一个黄色A = A + 2
并且您认为:“我的意思是A = A + 3
”,您可以在执行前更正该语句。
True
是的默认值,Application.ScreenUpdating
因此这是您在执行之前看到的值Application.ScreenUpdating = False
。
对于 Set WbkDest = ThisWorkbook,屏幕提示显示 WbkSet = Nothing 和 ThisWorkbook = ,但仅在黄色突出显示时才显示这些内容。当按下 F8 并移出那条线时,当我将光标放在它上面时它什么也没说。
如果您将鼠标悬停在普通变量(数据类型 = Long、String、Boolean 等)上,解释器将显示其值。一个对象(比如 WbkDest)有很多属性;解释器应该显示哪个?某些对象,例如Range
,具有默认属性。因此,Range
如果Value
您将鼠标悬停在某个范围上,您会看到该值。工作簿没有默认属性,因此解释器不显示任何内容。
转到立即窗口并键入? WbkDest.Name
并单击Enter。解释器将显示工作簿的名称。您可以获得显示的任何工作簿属性的值。您还可以显示子属性,例如:WbkDest.Worksheets.Count
或WbkDest.Worksheets("Sheet1").Range("A1").Value
。
[来自 OP 的注释:第一个错误- 我收到一个运行时“424”:当我输入“?WbkDest.Name' 并在即时窗口中按 Enter。是不是因为在开头 Dim 和后来的 Set = This Workbook 中声明了 WbkDest。我将我的 MASTER.xlsm 的名称更改为 MASTER_DESKTOP TEST.xlsm 但这无关紧要,因为我们从未在此代码中明确提及它,对吗?]
TD 对上述注释的响应 Dim X As Type
为 X 保留了一些空间,并将其值设置为该类型的默认值。对于 Long 类型,该值将为零。对于 Object 类型(Workbook 是 Object 的子类型),默认值为 Nothing。没有任何东西没有任何属性,所以在这个阶段? WbkDest.Name
会出错。Set WbkDest = ThisWorkbook
执行语句时,WbkDest
现在可以访问ThisWorkbook
. ThisWorkbook
有一个Name
所以? WbkDest.Name
会有一个值。你是对的; 您可以在不更改代码的情况下重命名工作簿。
设置 RngDest = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious) 其中 RngDest = 提示中没有任何内容,屏幕提示中除了 xlFormulas 的 -4123 和 xlByRows 的 1 之外没有任何内容弹出, 和 2 表示 xlPrevious。
我由此推断,您希望将新数据添加到先前运行宏的数据底部。根据我的经验,这是不寻常的,但我包含了此选项的代码以防万一。
[来自 OP 的注释:仅供参考,是的,Master 有标题,数据将添加到先前通过宏复制的数据下方。]
TD 对上述注释的回应我的代码比您需要的更复杂,但包含您想要的功能。如果主工作表为空,则将从第一个源工作表复制标题行和数据行。只会从任何其他工作簿复制数据行。如果主工作表不为空,则仅从源工作表复制数据行。
xlFormulas、xlByRows 和 xlPrevious 是 Excel 定义的常量,因此参数Find
是有意义的名称而不是奇怪的数字。
从列出的其他语句中,我推断目标工作簿当前为空。
[来自 OP 的注释:仅供参考,是的,主/目标 wkbk 在第一行有一个标题行,但一开始是空的。]
TD 对上述注释的回复 请 参阅我的最后回复。
执行 While FileName <> "" And FileName <> WbkDest.Name ,其中 FileName 和 WbkDest.Name = "MASTER.xlsm" 在屏幕提示中。然后 F8 跳转到其余代码的结尾,其中 With WshtDest .Cells.EntireColumn.AutoFit End With 等。
此时,您在我的代码中遇到了一个错误。我不明白为什么我的测试没有遇到这个错误。
你需要问:为什么循环退出了?为什么下一个文件没有重复?如果我省略了大部分代码,你会得到:
Do While FileName <> "" And FileName <> WbkDest.Name
‘ Code to process interesting file
FileName = Dir$
Loop ' While FileName <> "" And FileName <> WbkDest.Name
FileName <> ""
由于 FileName = “MASTER.xlsm” 为真,但FileName <> WbkDest.Name
由于“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 的注释:第二个错误我收到了一个编译错误 - 预期:然后或转到,所以我只是在 If FileName <> WbkDest.Name 之后添加了 Then,所以它显示为
If FileName <> WbkDest.Name Then
Set WbkSrc=Workbooks.Open (FolderPath & FileName)
'Rest of Code
这个对吗?]
TD 对上述注释的回应 是的,您是正确的。我应该包含经过测试的代码,而不是尝试创建摘要。
[来自 OP 的注释:第三个错误- 添加所有编辑后,我在运行下运行编译 VBA 项目,它说,编译错误:不执行循环,我不明白,因为循环我确定它指的是在底部,并且旁边从来没有“做”。换句话说,我不确定它为什么会在它从未有过“Do”的情况下引发错误。]
TD 对上述注释的响应编译错误“Loop without Do”、“Do without Loop”、“If within End If”、“End If without If”等可能会造成混淆。Do 循环、for 循环和 If 必须正确嵌套。如果你没有完全完成一个结构,编译器会抱怨可能是完美的外部结构。我的猜测,是你没有包括End If
新的If
. 当编译器点击Loop
它时,它正在寻找End If
嵌套结构的开头或开头。我已经用我刚刚再次测试过的修改后的代码替换了我的原始代码。您可以复制新代码并更新您的姓名。但是,最好将您的循环向下工作并将其与我的匹配。End If