首先，我在编码方面是一个新手，但是我想看看它是如何帮助我深入挖掘数据的。
我目前正在考虑为不同的团队成员捕获时间表数据并将其复制到主摘要工作簿中。
我录制了我的宏，然后重新组织了一些东西以使代码更清晰（这可能是我出错的地方）。但是现在当我运行我的宏时，我得到一个运行时错误'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
我相信这只是当我滚动到正确的位置并且取决于每次保存之前活动单元格时，这会改变。
我没有想法，任何帮助都会非常感激。
为了记录，到目前为止，我已经尝试了几种不同的方法 - 包括从网站复制和粘贴代码，按照管教程视频，但每次和每种方法都会发生同样的错误。
提前致谢，
富
更新
我重新录制了宏，并简单地改变了我在录制期间所做的顺序。我不再收到错误。但是代码非常混乱且冗长。屏幕在此过程中也会闪烁很多。有没有办法让用户体验更流畅？新代码在
下面 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
这样我就可以选择“master”中的哪个工作表来编写它，以及“2016_JAMAL”中的哪个工作表来复制它。
其次，我想从这张表上的两个范围复制 - C2：G2和C5：G56 我想以简化的方式做到这一点。
非常感谢您到目前为止的答案 - 我将阅读有关阵列的信息并通过5页进行操作！
富
答案 0 :(得分：1)
您可以通过设置以下内容来停止闪烁屏幕：
Application.ScreenUpdating = False
将其添加到宏并再次运行。
答案 1 :(得分：0)
您可以使用此功能加快“复制和粘贴”部分：
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
您还可以使用
使“关闭”部分更简单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
答案 2 :(得分：0)
我使用Activesheet不知道每个工作簿有多少张或其名称。你可以相应调整。这是我的版本：
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强制您声明变量并在使用后将对象设置回Nothing是一种很好的做法。
修改
对于每个工作簿，我会将Activesheet替换为Sheets("SheetName")。否则，您可以将以下代码放在每个工作簿的工作簿对象中（并将它们全部保存为启用宏），master除外，并保留Activesheet：
Private Sub Workbook_Open( )
Sheets ("SheetName").Activate
End Sub
我至少会将Workbooks("master").ActiveSheet更改为Workbooks("master").Sheets("SheetName")，或者您需要记住从正确（即活动）工作表中运行它。这是一个非常有用的link，也是。
答案 3 :(得分：0)
这将合并文件夹中所有工作簿的范围（下一个数据集低于之前）。
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