Excel VBA实现跨工作表列复制粘贴及字母升序排序问题求助

需要在Excel不同工作表间完成数据复制+排序操作，具体规则：

• 数据源：Sheet1的A列全量有效数据
• 目标位置：Sheet2的B列
• 处理要求：对迁移后的数据按a、b、c…的字母顺序做升序排列
• 效果示例：Sheet1 A列原始数据为(a, a, a, b ,c, a, b, d, a, b, a)时，Sheet2 B列最终输出为(a, a, a, a, a, a, b, b, b, c, d)

原有自行编写的VBA代码运行不符合预期，需要排查问题并提供修正方案。

• 逻辑存在硬编码缺陷：仅判断复制值为"a"的单元格，完全遗漏b、c、d等其他值的复制，未覆盖全量数据迁移要求
• 粘贴行号绑定循环变量i，遇到不符合判断条件的行时直接跳过粘贴，会在目标列生成大量错位空单元格
• 循环内反复执行整列空单元格删除、工作表激活、单元格选中操作，运行效率极低，还会触发行号偏移导致数据粘贴位置错误
• 判断逻辑错位：C列空值清理的触发条件，错误设置为检查Sheet2 A列单元格是否为空，完全无法实现预期的空值上移效果
• 循环起始值设为2，会直接漏掉Sheet1 A列第1行的数据
• 全程未编写排序相关逻辑，无法实现字母升序排列的核心要求

Sub Button1_Click()
    Dim lastRowSht1 As Long, lastRowSht2 As Long
    ' 关闭屏幕刷新提升运行速度，避免操作闪烁
    Application.ScreenUpdating = False
    
    ' 获取Sheet1 A列最后一行有效数据行号
    lastRowSht1 = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    ' 清空Sheet2 B列原有残留数据
    Worksheets("Sheet2").Range("B:B").ClearContents
    
    ' 批量复制Sheet1 A列全量有效数据到Sheet2 B列，替代逐行复制的低效逻辑
    Worksheets("Sheet1").Range("A1:A" & lastRowSht1).Copy _
        Destination:=Worksheets("Sheet2").Range("B1")
    
    ' 获取粘贴后Sheet2 B列最后一行有效数据行号
    lastRowSht2 = Worksheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row
    
    ' 调用Excel原生排序能力对B列做A-Z升序排列
    Worksheets("Sheet2").Sort.SortFields.Clear
    Worksheets("Sheet2").Sort.SortFields.Add2 _
        Key:=Range("B1:B" & lastRowSht2), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With Worksheets("Sheet2").Sort
        .SetRange Range("B1:B" & lastRowSht2)
        ' 首行是表头就改成xlYes，无表头改xlNo
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    MsgBox "数据迁移并排序完成"
End Sub

• 代码采用批量复制+原生排序的逻辑，完全替代原有逐行判断的冗余写法，不会出现空单元格错位问题，万行级数据运行也不会卡顿
• 如果需要同步迁移Sheet1 B列对应数据到Sheet2 C列，只需要在A列复制的代码段后新增一行批量复制代码即可，不需要额外写循环判断
• 如果数据首行是不需要参与排序的表头，将排序参数里的.Header = xlGuess修改为.Header = xlYes即可

内容的提问来源于stack exchange，提问作者blackmamba89