Excel宏技术求助：无法修改横向复制粘贴至可用区域的代码

原代码问题分析 #

你的代码逻辑错误导致无法实现需求：

• 原代码中Range("Q1" & Rows.Count).End(xlUp).Offset(17)是在纵向查找最后一行并偏移，而你需要的是横向在第一行移动粘贴区域
• 没有正确计算每次粘贴的起始列，也没实现"跳过一个单元格"的要求
• 过度使用Select和Selection，容易引发运行错误，且代码效率低

修正后的宏代码 #

Sub PasteHorizontally()
    ' 定义源区域
    Dim sourceRange As Range
    Set sourceRange = ThisWorkbook.ActiveSheet.Range("Q145:AE211")
    
    ' 计算源区域的列数（Q到AE共15列）
    Dim colCount As Integer
    colCount = sourceRange.Columns.Count
    
    Dim targetStartCol As Integer
    
    ' 首次粘贴：检查Q1:AE1是否为空
    If Application.CountA(Range("Q1:AE1")) = 0 Then
        targetStartCol = 17 ' Q列是第17列
    Else
        ' 在第一行找到最后一个有数据的单元格，计算下一个起始列（跳过1个空列）
        Dim lastUsedCol As Integer
        lastUsedCol = ThisWorkbook.ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
        targetStartCol = lastUsedCol + 2 ' 跳过1个空列，所以+2
    End If
    
    ' 定义目标区域：第一行，从targetStartCol开始，共colCount列
    Dim targetRange As Range
    Set targetRange = ThisWorkbook.ActiveSheet.Cells(1, targetStartCol).Resize(1, colCount)
    
    ' 直接粘贴值，无需复制粘贴
    targetRange.Value = sourceRange.Value
    
    Application.CutCopyMode = False
End Sub

代码说明 #

• 去掉了Select/Selection，直接通过对象引用操作单元格，避免运行时错误
• 用Application.CountA判断目标区域是否有数据，比IsEmpty更准确（IsEmpty仅判断单个单元格，无法识别区域内部分有数据的情况）
• 横向查找第一行最后使用的列，计算下一个起始列时+2，实现"跳过一个单元格"的要求
• 直接赋值targetRange.Value = sourceRange.Value比复制粘贴更高效，避免剪贴板占用

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