根据dwirony的评论更新：
我正在尝试创建一个代码，用于复制多个工作簿中相同单元格的信息，并将这些信息合并到一个摘要工作簿中。下面的代码按照写入的方式工作，但是，如果我向sourceRange添加更多单元格地址（从第69行开始），宏仍然会运行，但没有信息被复制到新的摘要工作簿中。
原始问题：
我正在尝试从单个文件夹中的多个工作表中选择相同的特定单元格，并将它们组合成主电子表格。代码可以使用一定数量的单元格，但如果我尝试再包含，则宏将返回一个空白工作簿（除了我已分配的列标题）。如果选择的单元格太多，最初工作的单元格将无法工作。即，在下面所示的代码中，单元J2是第一个和最后一个被调用的单元，程序运行。如果我再次添加J2，（范围结束...... J2，J2＆＃34;）或任何其他单元格，似乎我在某处达到了限制，我得到一张空白的工作簿。
我以前没有VBA和宏的经验，我所有的东西都来自各种互联网和内部资源。也许多个来源是错误的来源？
非常感谢任何帮助！
Sub MergeAllWorkbooks()
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
Dim a As Range, c As Range
Dim x As Long
' Change this to the path\folder location of your files.
MyPath = "C:\Users\amiller\OneDrive - CoorsTek\temp"
' Add a slash at the end of the path if needed.
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
' If there are no Excel files in the folder, exit.
FilesInPath = Dir(MyPath & "*.xls*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
' Fill the myFiles array with the list of Excel files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
' Set various application properties.
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 myFiles array.
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
' Change this range to fit your own needs.
With mybook.Worksheets(1)
Set sourceRange = .Range("J2, C2, D7, F7, K7, G10, J10, G11, J11, G12, J12, G14, J14, G15, J15, G16, J16, G17, J17, J21," _
& "J2, D24, E24, G24, I24, J24, O24, P24, Q24, R24, S24, D25, E25, G25, I25, J25, O25, P25, Q25, R25, S25," _
& "D26, E26, G26, I26, J26, O26, P26, Q26, R26, S26, D27, J2")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
' If source range uses 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 "There are not enough rows in the target worksheet."
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
' Copy the file name in column A.
With sourceRange
BaseWks.Cells(rnum + 1, "A"). _
Resize(.Rows.Count).Value = MyFiles(FNum)
End With
' Set the destination range.
Set destrange = BaseWks.Range("B" & rnum + 1)
x = 0
For Each a In sourceRange.Areas
For Each c In a.Cells
x = x + 1
destrange.Offset(0, x - 1).Value = c.Value
Next c
Next a
' Copy the values from the source range
' to the destination range.
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 the application properties.
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub