合并来自不同的Excel工作簿的数据
首先，在编码方面，我是一个新手，但是现在让我们来看看它是如何帮助我深入研究数据的。
我目前正在为不同的团队成员捕捉时间表数据并将其复制到主摘要工作簿中。
我logging了我的macros，然后重新组织了一些东西，使代码更清洁（这可能是我错误的地方）。 但是现在当我运行macros时，运行时错误“9”：下标超出范围。
我的代码如下：
Option Explicit Sub MergeAll() ' Open all Timesheets Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_JAMAL.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_LOKESH.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_NONI.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_RAJESH.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_SANTHOSH.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_7.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_8.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_9.xlsx" ' Activate and Copy Data Windows("2016_JAMAL.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_LOKESH.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_NONI.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_RAJESH.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_SANTHOSH.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_WARREN.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_7.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_8.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste Windows("2016_9.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2:F2").Select ActiveSheet.Paste ' Close all Timesheets Windows("2016_JAMAL.xlsx").Activate ActiveWindow.Close Windows("2016_LOKESH.xlsx").Activate ActiveWindow.Close Windows("2016_NONI.xlsx").Activate ActiveWindow.Close Windows("2016_RAJESH.xlsx").Activate ActiveWindow.Close Windows("2016_SANTHOSH.xlsx").Activate ActiveWindow.Close Windows("2016_WARREN.xlsx").Activate ActiveWindow.Close Windows("2016_7.xlsx").Activate ActiveWindow.Close Windows("2016_8.xlsx").Activate ActiveWindow.Close Windows("2016_9.xlsx").Activate ActiveWindow.Close End Sub 现在我拿出一些代码出现在每行，在Windows（“文件名”）之后。激活行。 这是：
ActiveWindow.SmallScroll Down:=-18
因为我相信这只是当我滚动到正确的位置，并且取决于每次保存之前哪个是活动单元时，这将会改变。
我没有想法，任何帮助将不胜感激。
为了logging，我到目前为止尝试了几种不同的方法 – 包括从站点复制和粘贴代码，跟随你pipe教程video，但是每次和每个方法，都会发生同样的错误。
提前致谢，
丰富
UPDATE
我重新logging了这个macros，并简单地改变了我在logging过程中所做的顺序。 我不再得到错误。 然而，代码非常混乱，冗长的啰嗦。 在这个过程中，屏幕也闪烁了很多。 有没有办法让用户更平滑的体验？ 新的代码如下
Sub MergeAll2() ' ' MergeAll2 Macro ' ' ' Open All Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_7.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_8.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_9.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_JAMAL.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_LOKESH.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_NONI.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_RAJESH.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_SANTHOSH.xlsx" Workbooks.Open Filename:= _ "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\2016_WARREN.xlsx" ' Copy & Paste Windows("2016_JAMAL.xlsx").Activate Range("G2:J2").Select Selection.Copy Windows("master.xlsm").Activate Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_LOKESH.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C3:F3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_NONI.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_RAJESH.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_SANTHOSH.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_WARREN.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_7.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C8").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_8.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("2016_9.xlsx").Activate Range("G2:J2").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsm").Activate Range("C10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ' Close All Windows("2016_JAMAL.xlsx").Activate ActiveWindow.Close Windows("2016_LOKESH.xlsx").Activate ActiveWindow.Close Windows("2016_NONI.xlsx").Activate ActiveWindow.Close Windows("2016_RAJESH.xlsx").Activate ActiveWindow.Close Windows("2016_SANTHOSH.xlsx").Activate ActiveWindow.Close Windows("2016_WARREN.xlsx").Activate ActiveWindow.Close Windows("2016_7.xlsx").Activate ActiveWindow.Close Windows("2016_8.xlsx").Activate ActiveWindow.Close Windows("2016_9.xlsx").Activate ActiveWindow.Close End Sub
更新2
非常感谢迄今为止的帮助。 我正在寻找编辑这一行：
Workbooks("master").ActiveSheet.Range("C2:F2").Value = Workbooks("2016_JAMAL").ActiveSheet.Range("G2:J2").Value
这样我就可以select“主”中的哪个工作表将其写入，还可以select“2016_JAMAL”中的哪个工作表进行复制。
其次，我想从这个表格上的两个范围复制 – C2：G2和C5：G56我想以一种简化的方式做到这一点。
非常感谢您的回答 – 我将阅读关于数组的信息并浏览5页！
丰富
您可以通过设置以下内容来停止闪烁屏幕：
Application.ScreenUpdating = False
将其添加到您的macros并再次运行。
你应该能够通过使用它来加速你的“复制和粘贴”部分：
With Workbooks("master").ActiveSheet .Range("C2:F2").Value = Workbooks("2016_JAMAL").ActiveSheet.Range("G2:J2").Value .Range("C3:F3").Value = Workbooks("2016_LOKESH").ActiveSheet.Range("G2:J2").Value .Range("C4:F4").Value = Workbooks("2016_NONI").ActiveSheet.Range("G2:J2").Value .Range("C5:F5").Value = Workbooks("2016_RAJESH").ActiveSheet.Range("G2:J2").Value .Range("C6:F6").Value = Workbooks("2016_SANTHOSH").ActiveSheet.Range("G2:J2").Value .Range("C7:F7").Value = Workbooks("2016_WARREN").ActiveSheet.Range("G2:J2").Value .Range("C8:F8").Value = Workbooks("2016_7").ActiveSheet.Range("G2:J2").Value .Range("C9:F9").Value = Workbooks("2016_8").ActiveSheet.Range("G2:J2").Value .Range("C10:F10").Value = Workbooks("2016_9").ActiveSheet.Range("G2:J2").Value End With
你也可以使你的“closures”部分更简单，使用：
Workbooks("2016_JAMAL.xlsx").Close False Workbooks("2016_LOKESH.xlsx").Close False Workbooks("2016_NONI.xlsx").Close False Workbooks("2016_RAJESH.xlsx").Close False Workbooks("2016_SANTHOSH.xlsx").Close False Workbooks("2016_WARREN.xlsx").Close False Workbooks("2016_7.xlsx").Close False Workbooks("2016_8.xlsx").Close False Workbooks("2016_9.xlsx").Close False
我用Activesheet不知道每个工作簿有多less张或他们的名字。 你可以相应地调整。 这是我的版本：
Option Explicit Sub MergeAll2() Dim wb2016_7 As Workbook Dim wb2016_8 As Workbook Dim wb2016_9 As Workbook Dim wb2016_JAMAL As Workbook Dim wb2016_LOKESH As Workbook Dim wb2016_NONI As Workbook Dim wb2016_RAJESH As Workbook Dim wb2016_SANTHOSH As Workbook Dim wb2016_WARREN As Workbook Dim strPath As String Application.ScreenUpdating = False strPath = "S:\UFD\24 Reports\02 Time Keeping\PT Time Sheets\" Set wb2016_7 = Workbooks.Open(Filename:=strPath & "2016_7.xlsx") Set wb2016_8 = Workbooks.Open(Filename:=strPath & "2016_8.xlsx") Set wb2016_9 = Workbooks.Open(Filename:=strPath & "2016_9.xlsx") Set wb2016_JAMAL = Workbooks.Open(Filename:=strPath & "2016_JAMAL.xlsx") Set wb2016_LOKESH = Workbooks.Open(Filename:=strPath & "2016_LOKESH.xlsx") Set wb2016_NONI = Workbooks.Open(Filename:=strPath & "2016_NONI.xlsx") Set wb2016_RAJESH = Workbooks.Open(Filename:=strPath & "2016_RAJESH.xlsx") Set wb2016_SANTHOSH = Workbooks.Open(Filename:=strPath & "2016_SANTHOSH.xlsx") Set wb2016_WARREN = Workbooks.Open(Filename:=strPath & "2016_WARREN.xlsx") With Workbooks("master").ActiveSheet .Range("C2:F2").Value = wb2016_JAMAL.ActiveSheet.Range("G2:J2").Value .Range("C3:F3").Value = wb2016_LOKESH.ActiveSheet.Range("G2:J2").Value .Range("C4:F4").Value = wb2016_NONI.ActiveSheet.Range("G2:J2").Value .Range("C5:F5").Value = wb2016_RAJESH.ActiveSheet.Range("G2:J2").Value .Range("C6:F6").Value = wb2016_SANTHOSH.ActiveSheet.Range("G2:J2").Value .Range("C7:F7").Value = wb2016_WARREN.ActiveSheet.Range("G2:J2").Value .Range("C8:F8").Value = wb2016_7.ActiveSheet.Range("G2:J2").Value .Range("C9:F9").Value = wb2016_8.ActiveSheet.Range("G2:J2").Value .Range("C10:F10").Value = wb2016_9.ActiveSheet.Range("G2:J2").Value End With wb2016_7.Close True wb2016_8.Close True wb2016_9.Close True wb2016_JAMAL.Close True wb2016_LOKESH.Close True wb2016_NONI.Close True wb2016_RAJESH.Close True wb2016_SANTHOSH.Close True wb2016_WARREN.Close True Set wb2016_7 = Nothing Set wb2016_8 = Nothing Set wb2016_9 = Nothing Set wb2016_JAMAL = Nothing Set wb2016_LOKESH = Nothing Set wb2016_NONI = Nothing Set wb2016_RAJESH = Nothing Set wb2016_SANTHOSH = Nothing Set wb2016_WARREN = Nothing Application.ScreenUpdating = True End Sub
使用Option Explicit是一个很好的习惯，它强制你声明你的variables并在使用它们之后将你的对象设置回Nothing 。
编辑
我会用Activesheet Sheets("SheetName")replaceActivesheet Sheets("SheetName")为每个工作簿。 否则，可以将每个工作簿的工作簿对象中的以下代码（并将它们全部保存为macros启用状态），除master之外，并保留Activesheet ：
Private Sub Workbook_Open( ) Sheets ("SheetName").Activate End Sub
至less，我会改变Workbooks("master").ActiveSheet到Workbooks("master").Sheets("SheetName")或者你需要记住从正确的（即，活动）工作表运行它。 这也是一个非常有用的链接 。
这将合并一个文件夹中所有工作簿的范围（下一个数据集在之前的下面）。
Sub Basic_Example_1() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim SourceRcount As Long, Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim rnum As Long, CalcMode As Long 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of Excel files in the folder Fnum = 0 Do While FilesInPath <> "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) rnum = 1 'Loop through all files in the array(myFiles) If Fnum > 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next With mybook.Worksheets(1) Set sourceRange = .Range("A1:C1") End With If Err.Number > 0 Then Err.Clear Set sourceRange = Nothing Else 'if SourceRange use all columns then skip this file If sourceRange.Columns.Count >= BaseWks.Columns.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceRcount = sourceRange.Rows.Count If rnum + SourceRcount >= BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in column A With sourceRange BaseWks.cells(rnum, "A"). _ Resize(.Rows.Count).Value = MyFiles(Fnum) End With 'Set the destrange Set destrange = BaseWks.Range("B" & rnum) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value rnum = rnum + SourceRcount End If End If mybook.Close savechanges:=False End If Next Fnum BaseWks.Columns.AutoFit End If ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub
这将合并一个文件夹中的所有工作簿的范围（接下来的数据集在先前的右侧）。
Sub Basic_Example_3() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim SourceCcount As Long, Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim Cnum As Long, CalcMode As Long 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of Excel files in the folder Fnum = 0 Do While FilesInPath <> "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) Cnum = 1 'Loop through all files in the array(myFiles) If Fnum > 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next Set sourceRange = mybook.Worksheets(1).Range("A1:A10") If Err.Number > 0 Then Err.Clear Set sourceRange = Nothing Else 'if SourceRange use all rows then skip this file If sourceRange.Rows.Count >= BaseWks.Rows.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceCcount = sourceRange.Columns.Count If Cnum + SourceCcount >= BaseWks.Columns.Count Then MsgBox "Sorry there are not enough columns in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in the first row With sourceRange BaseWks.cells(1, Cnum). _ Resize(, .Columns.Count).Value = MyFiles(Fnum) End With 'Set the destrange Set destrange = BaseWks.cells(2, Cnum) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value Cnum = Cnum + SourceCcount End If End If mybook.Close savechanges:=False End If Next Fnum BaseWks.Columns.AutoFit End If ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub