Excel宏问题咨询：需实现工作表非空时循环执行指定宏逻辑

首先，你的原宏只执行单次数据复制-粘贴-清空操作，要实现「工作表非空时持续循环」的功能，我们需要重构代码，加入循环逻辑，同时优化原代码中依赖Select的写法（这种写法容易因选中位置变化而出错，也不够高效）。

修改后的宏代码 #

' t Makro '
' Keyboard Shortcut: Ctrl+t '
Sub t_Makro()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRow As Long
    
    ' 提前绑定源工作表和目标工作表，避免反复切换选中
    Set sourceSheet = ThisWorkbook.Sheets("Hárok2")
    Set targetSheet = ThisWorkbook.Sheets("List3")
    
    ' 循环执行直到没有可处理的数据
    Do
        ' 定位需要处理的源数据范围：从当前选中单元格向下延伸到连续数据的末尾
        Set sourceRange = sourceSheet.Range(Selection, Selection.End(xlDown))
        
        ' 终止条件1：如果选中的区域只有一个空单元格，退出循环
        If sourceRange.Cells.Count = 1 And IsEmpty(sourceRange.Value) Then
            Exit Do
        End If
        
        ' 复制源数据
        sourceRange.Copy
        
        ' 找到目标工作表A列最后一行的下一行，作为粘贴起始位置
        targetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 转置粘贴到目标位置
        targetSheet.Range("A" & targetRow).PasteSpecial Paste:=xlPasteAll, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        
        ' 清空源数据区域
        sourceRange.ClearContents
        
        ' 定位下一次循环的起始单元格：当前处理区域下方的第一个单元格
        sourceSheet.Activate
        sourceRange.End(xlDown).Offset(1, 0).Select
        
        ' 终止条件2：如果下一个起始单元格为空，退出循环
        If IsEmpty(Selection.Value) Then
            Exit Do
        End If
    Loop
    
    ' 清除剪贴板的复制状态
    Application.CutCopyMode = False
End Sub

关键改进说明 #

• 移除冗余的Select操作：用工作表对象变量sourceSheet和targetSheet直接操作，避免因手动选中位置变化导致的错误，同时提升宏的执行速度。
• 循环逻辑：通过Do...Loop实现持续执行，设置两个终止条件，确保在源工作表没有可处理数据时自动停止循环。
• 可靠的目标行定位：用Cells(Rows.Count, "A").End(xlUp).Row获取目标工作表A列最后一行非空单元格的行号，比原代码的Range("A1").End(xlDown)更稳定（原写法在A1为空时会跳到工作表最后一行，引发错误）。

如果你的源数据结构有特殊情况（比如非连续的数据块），可以根据实际需求调整循环的终止条件，比如检查源工作表某一列是否还有非空值。

内容的提问来源于stack exchange，提问作者Viktória