我一直在研究你的宏的最终结果。我的目标是找出实现该结果的更好方法，而不是整理现有方法。
您将两个工作簿命名为：“Room Checksums.xls”和“GetReference.xlsm”。 “xls”是 Excel 2003 工作簿的扩展名。 “xlsm”是包含宏的 2003 年后工作簿的扩展。也许您正确使用了这些扩展，但您应该检查一下。
我使用 Excel 2003，所以我所有的工作簿都有“xls”的扩展名。我怀疑您需要更改此设置。
我创建了三个工作簿：“Room Checksums.xls”、“GetReference.xls”和“Macros.xls”。 “Room Checksums.xls”和“GetReference.xls”只包含数据。宏在“Macros.xls”中。当只有特权用户可以运行宏并且我不希望普通用户被这些宏打扰或访问时，我使用这个划分。如果您愿意，可以将下面的宏放置在“GetReference.xls”中而无需更改。
下图显示了“Room Checksums.xls”的工作表“Sheet1”。我隐藏了大部分行和列，因为它们不包含与您的宏相关的内容。为方便起见，我已将单元格值设置为它们的地址，但这些值没有其他意义。
我运行了你的宏。 “Room Checksums.xls”的“Sheet2”变为：
注意：公式栏将单元格 A1 显示为 =Sheet1!$B$6。也就是说，这是一个链接而不是一个值。
“GetReference.xls”的活动工作表变为：
注意 1：C 到 L 列中的零是因为您移动了 12 列。我假设您的“Room Checksums.xls”的“Sheet2”的这些列中还有您想要的其他数据。
注意 2：公式栏将单元格 A8 显示为 ='[Room Checksums.xls]Sheet2'!A1。
我的宏实现了与您相同的结果，但方式有所不同。但是，我需要解释我的宏的许多功能。它们不是绝对必要的，但我相信它们代表了良好的做法。
您的宏包含很多我称之为幻数的东西。例如：B6、AN99、108 和 A8。这些价值观可能对贵公司有意义，但我怀疑它们是当前工作簿的意外。您多次使用值 108。如果此值更改为 109，则您必须在代码中搜索 108 并将其替换为 109。数字 108 非常不寻常，不太可能由于其他原因出现在您的代码中，但其他数字可能不会如此不寻常，使更换成为一项艰巨的任务。目前您可能知道这个数字的含义。你会记得 12 个月后你回来修改这个宏吗？
我已将 108 定义为常量：
Const Offset1 As Long = 108
我想要一个更好的名字，但我不知道这个数字是多少。您可以用更有意义的名称替换所有出现的“Offset1”。或者，您可以添加 cmets 来解释它是什么。如果该值变为 109，则对该语句进行一次更改即可解决问题。我认为我的大部分名字都应该换成更有意义的名字。
您假设“Room Checksums.xls”和“GetReference.xlsm”是打开的。如果其中一个都没有打开，宏将在相关的激活语句处停止。也许早期的宏已经打开了这些工作簿，但我添加了代码来检查它们是否打开。
我的宏没有粘贴任何东西。它分为三个阶段：
-
处理“Room Checksums.xls”的工作表“Sheet1”以识别序列中的最后一个非空单元格：B6、B114、B222、B330、B438、...。
李>
在“Room Checksums.xls”的工作表“Sheet2”中创建指向这些条目（和 AN99 系列）的链接。公式只是以符号“=”开头的字符串，它们可以像任何其他字符串一样创建。
在“GetReference.xls”的工作表“Xxxxxx”中创建链接到“Room Checksums.xls”的“Sheet2”中的表格。我不喜欢依赖正确的工作表处于活动状态。你必须用正确的值替换“Xxxxxx”。
在我的宏中，我试图解释我在做什么，但我没有对我正在使用的语句的语法多说。您应该很容易找到语法解释，但如果有必要请询问。
我想你会发现我的一些陈述令人困惑。例如：
.Cells(RowSrc2Crnt, Col1Src2).Value = "=" & WshtSrc1Name & "!$" & Col1Src1 & _
"$" & Row1Src1Start + OffsetCrnt
没有一个名称像我想要的那样有意义，因为我不了解工作表、列和偏移量的用途。我没有复制和粘贴，而是构建了一个公式，例如“=Sheet1!$B$6”。如果您通过表达式工作，您应该能够将每个术语与公式的元素相关联：
"=" =
WshtSrc1Name Sheet1
"!$" !$
Col1Src1 B
"$" $
Row1Src1Start + OffsetCrnt 6
这个宏并不像我自己编写的那样，因为我更喜欢使用数组而不是直接访问工作表。我决定在不添加数组的情况下引入足够多的概念。
即使没有数组，这个宏对于新手来说也比我开始编写它时的预期更难理解。它分为三个独立的阶段，每个阶段都有不同的目的，应该会有所帮助。如果你研究它，我希望你能明白为什么如果改变工作簿的格式会更容易维护。如果你有大量数据，这个宏会比你的快很多。
Option Explicit
Const ColDestStart As Long = 1
Const Col1Src1 As String = "B"
Const Col2Src1 As String = "AN"
Const Col1Src2 As String = "A"
Const Col2Src2 As String = "B"
Const ColSrc2Start As Long = 1
Const ColSrc2End As Long = 12
Const Offset1 As Long = 108
Const RowDestStart As Long = 8
Const Row1Src1Start As Long = 6
Const Row2Src1Start As Long = 99
Const RowSrc2Start As Long = 1
Const WbookDestName As String = "GetReference.xls"
Const WbookSrcName As String = "Room Checksums.xls"
Const WshtDestName As String = "Xxxxxx"
Const WshtSrc1Name As String = "Sheet1"
Const WshtSrc2Name As String = "Sheet2"
Sub GetCellsRevised()
Dim ColDestCrnt As Long
Dim ColSrc2Crnt As Long
Dim InxEntryCrnt As Long
Dim InxEntryMax As Long
Dim InxWbookCrnt As Long
Dim OffsetCrnt As Long
Dim OffsetMax As Long
Dim RowDestCrnt As Long
Dim RowSrc2Crnt As Long
Dim WbookDest As Workbook
Dim WbookSrc As Workbook
' Check the source and destination workbooks are open and create references to them.
Set WbookDest = Nothing
Set WbookSrc = Nothing
For InxWbookCrnt = 1 To Workbooks.Count
If Workbooks(InxWbookCrnt).Name = WbookDestName Then
Set WbookDest = Workbooks(InxWbookCrnt)
ElseIf Workbooks(InxWbookCrnt).Name = WbookSrcName Then
Set WbookSrc = Workbooks(InxWbookCrnt)
End If
Next
If WbookDest Is Nothing Then
Call MsgBox("I need workbook """ & WbookDestName & """ to be open", vbOKOnly)
Exit Sub
End If
If WbookSrc Is Nothing Then
Call MsgBox("I need workbook """ & WbookSrcName & """ to be open", vbOKOnly)
Exit Sub
End If
' Phase 1. Locate the last non-empty cell in the sequence: B6, B114, B222, ...
' within source worksheet 1
OffsetCrnt = 0
With WbookSrc.Worksheets(WshtSrc1Name)
Do While True
If .Cells(Row1Src1Start + OffsetCrnt, Col1Src1).Value = "" Then
Exit Do
End If
OffsetCrnt = OffsetCrnt + Offset1
Loop
End With
If OffsetCrnt = 0 Then
Call MsgBox("There is no data to reference", vbOKOnly)
Exit Sub
End If
OffsetMax = OffsetCrnt - Offset1
' Phase 2. Build table in source worksheet 2
RowSrc2Crnt = RowSrc2Start
With WbookSrc.Worksheets(WshtSrc2Name)
For OffsetCrnt = 0 To OffsetMax Step Offset1
.Cells(RowSrc2Crnt, Col1Src2).Value = "=" & WshtSrc1Name & "!$" & Col1Src1 & _
"$" & Row1Src1Start + OffsetCrnt
.Cells(RowSrc2Crnt, Col2Src2).Value = "=" & WshtSrc1Name & "!$" & Col2Src1 & _
"$" & Row2Src1Start + OffsetCrnt
RowSrc2Crnt = RowSrc2Crnt + 1
Next
End With
' Phase 3. Build table in destination worksheet
RowSrc2Crnt = RowSrc2Start
RowDestCrnt = RowDestStart
With WbookDest.Worksheets(WshtDestName)
For OffsetCrnt = 0 To OffsetMax Step Offset1
ColDestCrnt = ColDestStart
For ColSrc2Crnt = ColSrc2Start To ColSrc2End
.Cells(RowDestCrnt, ColDestCrnt).Value = _
"='[" & WbookSrcName & "]" & WshtSrc2Name & "'!" & _
ColNumToCode(ColSrc2Crnt) & RowSrc2Crnt
ColDestCrnt = ColDestCrnt + 1
Next
RowSrc2Crnt = RowSrc2Crnt + 1
RowDestCrnt = RowDestCrnt + 1
Next
End With
End Sub
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function