首先，我确定您代码中的一些错误和不良做法，然后考虑如何重新设计您的宏以实现您的目标。
问题 1
On Error 的主要目的是让您在发生意外错误时整齐地终止。您不应该使用它来避免预期的错误，也不应该忽略错误。
考虑函数LastRow 和LastCol。在这两种情况下，如果 Find 失败，您将忽略错误并继续。但这意味着这些函数返回不正确的值，因此您在调用例程中会遇到另一个错误。如果查找失败，您应该调查而不是忽略。任何其他错误都是如此。
问题 2
如果工作表为空，则 Find 返回 Nothing。当工作表“RDBMergeSheet”为空时，您可以调用函数LastRow 和LastCol。代码应该是：
Set Rng = sh.Cells.Find( ...)
If Rng Is Nothing Then
' Sheet sh is empty
LastRow = 0
Else
LastRow = Rng.Row
End If
如果工作表为空，我将 LastRow 设置为 0。这不再是错误的副作用，而是该函数的记录功能：“返回值 = 0 表示工作表为空。”调用例程必须检查此值并跳过任何空工作表。还有其他方法，但关键是：提供代码以整齐的方式处理预期或可能的错误。对于函数 LastCol，您需要 LastCol = Rng.Column。
问题 3
函数语句的最小语法是：
Function Name( ... parameters ...) As ReturnType
两个函数语句应该结束：As Long。
问题 4
考虑：“ActiveWorkbook.Worksheets("RDBMergeSheet")”
如果您正在处理多个工作簿，ActiveWorkbook 是不够的。如果您只处理一个工作簿，则不需要ActiveWorkbook。在您对 Excel VBA 有更好的理解之前，请不要使用多个工作簿。
问题 5
您删除工作表“RDBMergeSheet”，然后重新创建它，这伤害了我的灵魂。更重要的是，您丢失了列标题。我将在重新设计中进一步讨论这个问题。
替换：
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"
与：
Set DestSh = Worksheets("RDBMergeSheet")
With DestSh
.Range(.Cells(2, 1), .Cells(Rows.Count, Columns.Count)).EntireRow.Delete
End With
您在代码中使用了Rows.Count、With 和Cells，所以我不会解释它们。
.Range(.Cells(RowTop, ColLeft), .Cells(RowBottom, ColRight)) 是一种使用左上角和右下角单元格指定范围的简单方法。
我使用了.EntireRow，所以我不需要列号。下面给出了相同的效果：
.Rows("2:" & Rows.Count).EntireRow.Delete
据我所知ClearContents（有些人喜欢）与Delete 具有相同的效果。它当然需要相同的微秒数。对于上述用法，两者都从工作表的第二行到最后一行删除任何值或格式。
上述变化意味着第1行不变，列宽不丢失。我不需要你用过的 AutoFit。
问题 6
请系统地命名变量。您使用StartRow 作为第一行，shLast 作为源工作表的最后一行，Last 作为目标工作表的最后一行。负责维护您的宏的同事会觉得这很容易理解吗？当这个宏需要一些维护时，你会在六个月后记住它吗？
开发适合您的命名系统。更好的是，与同事聚在一起并同意一个单一的系统，这样你雇主的所有宏看起来都一样。记录此系统以供未来员工使用。我将这些变量命名为：RowNumDestLast、RowNumSrcStart 和 RowNumSrcLast。即： 。该系统适用于我，但您的系统可能完全不同。一个好的系统的关键特性是你可以在一年内查看你的代码并立即知道每个语句在做什么。
第 7 期
If shLast > 0 And shLast >= StartRow Then
您将 StartRow 设置为 1 并且永远不会更改它，所以如果 shLast >= StartRow 然后是 shLast > 0。以下就足够了：
If shLast >= StartRow Then
问题 8
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
您正在检查会导致致命错误的条件很好，但这是最可能的错误吗？即使您使用的是 Excel 2003，也有可容纳 65,535 人的空间和一个标题行。在超过最大行数之前，您将打破工作簿的大小限制。
第 9 期
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
这包括要复制的范围内的标题行。由于稍后我会建议完全不同的方法，因此我不会建议更正。
第 10 期
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
为什么要分别粘贴值和格式？
重新设计
通过上面的更正，代码可以正常工作。使用您的源数据，它将目标工作表设置为：
Age Name Dept
Name Age
Sathish 22
Sarathi 24
Age Name Dept
60 Saran Comp sce
31 Rajan B.com
这不是你想要的。所以这个答案的其余部分是关于设计的：你如何实现你所寻求的外观？有很多方法，但我提供了一种并解释了为什么我选择了它而不讨论替代方案。
关键问题：
- 您如何确定要合并的列以及合并的顺序？
- 如果源工作表中有您不期望的列，您会怎么做？是否有人在收集没有核心利益的信息或列名拼写错误？
我决定使用工作表“RDBMergeSheet”中的现有列名来确定顺序。要为新列名准备宏，只需将该名称添加到“RDBMergeSheet”。如果我在源工作表中发现不在“RDBMergeSheet”中的列名，我会将其添加到右侧。如果列名拼写错误，第二个决定将突出显示错误，但如果有人在源工作表中收集额外信息，则不会有任何好处。
我不会将格式复制到工作表“RDBMergeSheet”，因为如果源工作表的格式不同，则工作表“RDBMergeSheet”的每个部分都会不同。
新的陈述和解释
Const RowFirstData As Long = 2
Const WShtDestName As String = "RDBMergeSheet"
常量意味着我在代码中使用名称，并且可以通过更改 Const 语句来更改值。
我假设每个工作表的第一行都包含列名，并且第一个数据行是 2。我使用一个常量来明确这个假设。可以使用它来编写可以处理不同数量的标题行的代码，但我没有这样做，因为它会使代码复杂化而没有什么好处。
ColNumDestLast = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, Columns.Count) 标识第 1 行的最后一列，我认为它是空白的。 .End(xlToLeft) 是键盘 Ctrl+Left 的 VBA 等效项。如果.Cells(1, Columns.Count) 为空白，.Cells(1, Columns.Count).End(xlToLeft) 返回左侧第一个非空白单元格。 .Column 给出该单元格的列号。也就是说，此语句将 ColNumDestStart 设置为第 1 行中最后一个单元格的列号。
ColHeadDest = .Range(.Cells(1, 1), .Cells(1, ColNumDestLast)).Value
这会将第 1 行的值复制到变量数组 ColHeadDest。 ColHeadDest 将通过此声明重新调整为 (1 to 1, 1 to ColNumDestLast)。第一个维度是行，只有一个，第二个维度是列。
更换合并
我希望我已经添加了足够多的 cmets 以使代码有意义。您仍然需要更正后的LastRow 和LastCol。我本可以替换 LastRow 和 LastCol，但我想我已经提供了足够的新代码来继续使用。
Option Explicit
Sub consolidate()
Dim ColHeadCrnt As String
Dim ColHeadDest() As Variant
Dim ColNumDestCrnt As Long
Dim ColNumDestLast As Long
Dim ColNumSrcCrnt As Long
Dim ColNumSrcLast As Long
Dim Found As Boolean
Dim RowNumDestCrnt As Long
Dim RowNumDestStart As Long
Dim RowNumSrcCrnt As Long
Dim RowNumSrcLast As Long
Dim WShtDest As Worksheet
Dim WShtSrc As Worksheet
Dim WShtSrcData() As Variant
Const RowNumFirstData As Long = 2
Const WShtDestName As String = "RDBMergeSheet"
'With Application
' .ScreenUpdating = False ' Don't use these
' .EnableEvents = False ' during development
'End With
Set WShtDest = Worksheets(WShtDestName)
With WShtDest
' Clear existing data and load column headings to ColHeadDest
.Rows("2:" & Rows.Count).EntireRow.Delete
ColNumDestLast = .Cells(1, Columns.Count).End(xlToLeft).Column
ColHeadDest = .Range(.Cells(1, 1), _
.Cells(1, ColNumDestLast)).Value
End With
' Used during development to check array loaded correctly
'For ColNumDestCrnt = 1 To ColNumDestLast
' Debug.Print ColHeadDest(1, ColNumDestCrnt)
'Next
RowNumDestStart = RowNumFirstData ' Start for first source worksheet
For Each WShtSrc In Worksheets
ColNumSrcLast = LastCol(WShtSrc)
RowNumSrcLast = LastRow(WShtSrc)
If WShtSrc.Name <> WShtDestName And _
RowNumSrcLast <> 0 Then
' Source sheet is not destination sheet and it is not empty.
With WShtSrc
' Load entire worksheet to array
WShtSrcData = .Range(.Cells(1, 1), _
.Cells(RowNumSrcLast, ColNumSrcLast)).Value
End With
With WShtDest
For ColNumSrcCrnt = 1 To ColNumSrcLast
' For each column in source worksheet
Found = False
ColHeadCrnt = WShtSrcData(1, ColNumSrcCrnt)
' Find matching column in destination worksheet
For ColNumDestCrnt = 1 To ColNumDestLast
If ColHeadCrnt = ColHeadDest(1, ColNumDestCrnt) Then
Found = True
Exit For
End If
Next ColNumDestCrnt
If Not Found Then
' Current source column's name is not present in the
' destination sheet Add new column name to array and
' destination worksheet
ColNumDestLast = ColNumDestLast + 1
ReDim Preserve ColHeadDest(1 To 1, 1 To ColNumDestLast)
ColNumDestCrnt = ColNumDestLast
With .Cells(1, ColNumDestCrnt)
.Value = ColHeadCrnt
.Font.Color = RGB(255, 0, 0)
End With
ColHeadDest(1, ColNumDestCrnt) = ColHeadCrnt
End If
' I could extract data from WShtSrcData to another array
' suitable for downloading to a column of a worksheet but
' it is easier to move the data directly to the worksheet.
' Also, athought downloading via an array is marginally
' faster than direct access, loading the array will reduce,
' and perhaps eliminate, the time benefit of using an array.
RowNumDestCrnt = RowNumDestStart
For RowNumSrcCrnt = RowNumFirstData To RowNumSrcLast
' Copy value from array of source data to destination sheet
.Cells(RowNumDestCrnt, ColNumDestCrnt) = _
WShtSrcData(RowNumSrcCrnt, ColNumSrcCrnt)
RowNumDestCrnt = RowNumDestCrnt + 1
Next
Next ColNumSrcCrnt
End With ' WShtDest
' Adjust RowNumDestStart ready for next source worksheet
RowNumDestStart = RowNumDestStart + RowNumSrcLast - RowNumFirstData + 1
End If ' Not destination sheet and not empty source sheet
Next WShtSrc
With WShtDest
' Leave workbook with destination worksheet visible
.Activate
End With
'With Application
' .ScreenUpdating = True
' .EnableEvents = True
'End With
End Sub