如何使用 Excel VBA 激活多个工作簿中的多个工作表中的行数据并将其复制到另一个工作簿的工作表中？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5261817/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-11 12:48:58 来源:igfitidea点击:
How to use Excel VBA to activate and copy row data from multiple worksheets in multiple workbooks into another workbook's worksheet?
提问by Jared Farrish
I have a series of workbooks, containing a series of worksheets, in which I am needing to consolidate those worksheets into one worksheet (they are all identical columns).
我有一系列工作簿，其中包含一系列工作表，我需要将这些工作表合并到一个工作表中（它们都是相同的列）。
I have the below snippet from my combined() sub that I'm trying to use to access each file, iterate over them, get each worksheet inside, and then copy the contents of each worksheet over to the combined.xlsm file.
我有来自我的 combine() 子的以下片段，我试图用它来访问每个文件，遍历它们，将每个工作表放入其中，然后将每个工作表的内容复制到 combine.xlsm 文件中。
My problem is, I'm not quite following how I should activate the workbooks/worksheets with my code. Is my code just not going to work?
我的问题是，我不太了解如何使用我的代码激活工作簿/工作表。我的代码不会工作吗？
CombinedWB = "Combined.xlsm"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLS = FSO.GetFolder("c:\path\to\files").Files
Row = 1
For Each F In FLS
CurrentWB = F.Name
Windows(CurrentWB).Activate
If CurrentWB <> CombinedWB Then
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Combined").Delete
Application.DisplayAlerts = True
If Row = 1 Then
Windows(CombinedWB).Activate
For Each Cell In ActiveSheet.Range("A3")
Worksheets("Combined").Range("A" & Row).Value = "Name"
Worksheets("Combined").Range("B" & Row).Value = "Player"
Worksheets("Combined").Range("C" & Row).Value = Cell.Value
Worksheets("Combined").Range("D" & Row).Value = Cell.Offset(0, 1).Value
Worksheets("Combined").Range("E" & Row).Value = Cell.Offset(0, 2).Value
Worksheets("Combined").Range("F" & Row).Value = Cell.Offset(0, 3).Value
Worksheets("Combined").Range("G" & Row).Value = Cell.Offset(0, 4).Value
Worksheets("Combined").Range("H" & Row).Value = Cell.Offset(0, 5).Value
Worksheets("Combined").Range("I" & Row).Value = Cell.Offset(0, 6).Value
Worksheets("Combined").Range("J" & Row).Value = Cell.Offset(0, 7).Value
Worksheets("Combined").Range("K" & Row).Value = Cell.Offset(0, 8).Value
Worksheets("Combined").Range("L" & Row).Value = Cell.Offset(0, 9).Value
Worksheets("Combined").Range("M" & Row).Value = Cell.Offset(0, 10).Value
Worksheets("Combined").Range("N" & Row).Value = Cell.Offset(0, 11).Value
Worksheets("Combined").Range("O" & Row).Value = Cell.Offset(0, 12).Value
Worksheets("Combined").Range("P" & Row).Value = Cell.Offset(0, 13).Value
Next
Windows(CurrentWB).Activate
Row = 2
End If
For J = 1 To Sheets.Count
Player = Sheets(J).Cells(1).Parent.Name
Injury = Sheets(J).Range("A5").Value
InjuryDate = Sheets(J).Range("B5").Value
For Each Cell In Sheets(J).Range("A5:A100")
Windows(CombinedWB).Activate
If IsEmpty(Cell.Offset(0, 2).Value) <> True Then
Worksheets("Combined").Range("A" & Row).Value = Name
Worksheets("Combined").Range("B" & Row).Value = Player
Worksheets("Combined").Range("C" & Row).Value = Injury
Worksheets("Combined").Range("D" & Row).Value = InjuryDate
Worksheets("Combined").Range("E" & Row).Value = Cell.Offset(0, 2).Value
Worksheets("Combined").Range("F" & Row).Value = Cell.Offset(0, 3).Value
Worksheets("Combined").Range("G" & Row).Value = Cell.Offset(0, 4).Value
Worksheets("Combined").Range("H" & Row).Value = Cell.Offset(0, 5).Value
Worksheets("Combined").Range("I" & Row).Value = Cell.Offset(0, 6).Value
Worksheets("Combined").Range("J" & Row).Value = Cell.Offset(0, 7).Value
Worksheets("Combined").Range("K" & Row).Value = Cell.Offset(0, 8).Value
Worksheets("Combined").Range("L" & Row).Value = Cell.Offset(0, 9).Value
Worksheets("Combined").Range("M" & Row).Value = Cell.Offset(0, 10).Value
Worksheets("Combined").Range("N" & Row).Value = Cell.Offset(0, 11).Value
Worksheets("Combined").Range("O" & Row).Value = Cell.Offset(0, 12).Value
Worksheets("Combined").Range("P" & Row).Value = Cell.Offset(0, 13).Value
Row = Row + 1
End If
Next
Next
End If
Next
EDIT
编辑
Here is the final working code (thanks to mwolfe02):
这是最终的工作代码（感谢 mwolfe02）：
Sub Combine()
Dim J As Integer
Dim Sport As String
Dim Player As String
Dim Injury As String
Dim InjuryDate As String
Dim Row As Integer
Dim FSO As Object
Dim FLS As Object
Dim CurrentWB As String
Dim CombinedWB As String
Dim CombinedWBTemp As String
Dim wb As Workbook
Dim cwb As Workbook
Dim ws As Worksheet
Dim cws As Worksheet
CombinedWB = "Combined.xlsm"
CombinedWBTemp = "~$" & CombinedWB
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLS = FSO.GetFolder("c:\path\to\files").Files
Set cwb = Workbooks(CombinedWB)
Set cws = cwb.Worksheets("Combined")
cws.Range("A1:Z3200").Clear
Row = 1
For Each F In FLS
CurrentWB = F.Name
If CurrentWB <> CombinedWB And CurrentWB <> CombinedWBTemp Then
On Error Resume Next
Set wb = Workbooks.Open(CurrentWB)
On Error Resume Next
If Not wb.Sheets("Combined") Is Nothing Then
Application.DisplayAlerts = False
wb.Sheets("Combined").Delete
Application.DisplayAlerts = True
End If
If Row = 1 Then
For Each Cell In wb.Sheets(1).Range("A3")
cws.Range("A" & Row).Value = "Sport"
cws.Range("B" & Row).Value = "Player"
cws.Range("C" & Row).Value = Cell.Value
cws.Range("D" & Row).Value = Cell.Offset(0, 1).Value
cws.Range("E" & Row).Value = Cell.Offset(0, 2).Value
cws.Range("F" & Row).Value = Cell.Offset(0, 3).Value
cws.Range("G" & Row).Value = Cell.Offset(0, 4).Value
cws.Range("H" & Row).Value = Cell.Offset(0, 5).Value
cws.Range("I" & Row).Value = Cell.Offset(0, 6).Value
cws.Range("J" & Row).Value = Cell.Offset(0, 7).Value
cws.Range("K" & Row).Value = Cell.Offset(0, 8).Value
cws.Range("L" & Row).Value = Cell.Offset(0, 9).Value
cws.Range("M" & Row).Value = Cell.Offset(0, 10).Value
cws.Range("N" & Row).Value = Cell.Offset(0, 11).Value
cws.Range("O" & Row).Value = Cell.Offset(0, 12).Value
cws.Range("P" & Row).Value = Cell.Offset(0, 13).Value
Next
Row = 2
End If
For Each ws In wb.Worksheets
Player = ws.Cells(1).Parent.Name
Injury = ws.Range("A5").Value
InjuryDate = ws.Range("B5").Value
For Each Cell In ws.Range("A5:A100")
If IsEmpty(Cell.Offset(0, 2).Value) <> True Then
cws.Range("A" & Row).Value = wb.Name
cws.Range("B" & Row).Value = Player
cws.Range("C" & Row).Value = Injury
cws.Range("D" & Row).Value = InjuryDate
cws.Range("E" & Row).Value = Cell.Offset(0, 2).Value
cws.Range("F" & Row).Value = Cell.Offset(0, 3).Value
cws.Range("G" & Row).Value = Cell.Offset(0, 4).Value
cws.Range("H" & Row).Value = Cell.Offset(0, 5).Value
cws.Range("I" & Row).Value = Cell.Offset(0, 6).Value
cws.Range("J" & Row).Value = Cell.Offset(0, 7).Value
cws.Range("K" & Row).Value = Cell.Offset(0, 8).Value
cws.Range("L" & Row).Value = Cell.Offset(0, 9).Value
cws.Range("M" & Row).Value = Cell.Offset(0, 10).Value
cws.Range("N" & Row).Value = Cell.Offset(0, 11).Value
cws.Range("O" & Row).Value = Cell.Offset(0, 12).Value
cws.Range("P" & Row).Value = Cell.Offset(0, 13).Value
Row = Row + 1
End If
Next
Next
wb.Close SaveChanges:=True
End If
Next
Windows(CombinedWB).Activate
Sheets("Combined").Activate
End Sub
回答by mwolfe02
Your problems are caused by using the .Activatemethod. There is no need for that in what you are trying to do. Code created using the macro recorder is littered with .Activatecalls, but they are generally a bad idea when writing code yourself.
您的问题是由使用该.Activate方法引起的。在您尝试做的事情中没有必要这样做。使用宏记录器创建的代码充满了.Activate调用，但在自己编写代码时通常是个坏主意。
Try something more like this:
尝试更像这样的事情：
Const CombinedWB As String = "Combined.xlsm"
Dim FSO As Object, FLS As Object, F As Object
Dim wb As Workbook, ws As Worksheet
Dim cwb As Workbook 'This will be our combined workbook'
Dim cws As Worksheet 'This will be the combined worksheet'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLS = FSO.GetFolder("c:\path\to\files").Files
Set cwb = Workbooks.Open(CombinedWB)
'Use the following line if there is just a single combined worksheet'
' and it is in the combined workbook'
Set cws = cwb.Worksheets("Combined")
For Each F In FLS
Set wb = Workbooks.Open(F.Name)
If F.Name <> CombinedWB Then
....
'Use the following line if each workbook has a combined worksheet'
Set cws = wb.Worksheets("Combined")
For Each ws In wb.Worksheets
cws.Range("A1") = cws.Range("A1") + ws.Range("A1")
....
Next ws
End If
wb.Close SaveChanges:=True
Next F
