Excel VBA宏优化：仅复制有数据单元格并添加无数据提示

问题根源 #

你原来使用Range(Selection, Selection.End(xlDown)).Select的方式获取数据范围，当目标区域只有一行数据时，End(xlDown)会直接跳到工作表最后一行，导致复制大量空单元格。同时原代码缺少空数据检测逻辑，无法在无数据时给出提示。

修改后的完整代码 #

Sub HDR_22()
    Dim wsHeader As Worksheet
    Dim wsZone As Worksheet
    Dim lastRowCI As Long
    Dim lastRowCK As Long
    Dim lastColCK As Long
    
    ' 定义工作表变量，避免频繁切换/选择工作表
    Set wsHeader = ThisWorkbook.Sheets("HEADER SCHEDULES")
    Set wsZone = ThisWorkbook.Sheets("ZONE 2")
    
    ' 展开大纲
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
    
    ' 清除主表现有数据
    With wsHeader
        .Zoom = 60
        ' 清除A52:B列下方有数据的区域
        If .Range("A52").Value <> "" Then
            .Range("A52:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
        End If
        ' 清除F列开始到右侧有数据的区域
        If .Range("F52").Value <> "" Then
            lastColCK = .Range("F52").End(xlToRight).Column
            .Range(.Cells(52, "F"), .Cells(.Cells(.Rows.Count, "F").End(xlUp).Row, lastColCK)).ClearContents
        End If
        ' 清除Y52下方有数据的区域
        If .Range("Y52").Value <> "" Then
            .Range("Y52:Y" & .Cells(.Rows.Count, "Y").End(xlUp).Row).ClearContents
        End If
    End With
    
    ' 处理ZONE 2中CI2:CJ2区域的数据复制
    With wsZone
        ' 获取CI列最后一行有数据的行号（从底部往上找）
        lastRowCI = .Cells(.Rows.Count, "CI").End(xlUp).Row
        
        ' 判断是否有有效数据
        If lastRowCI < 2 Or .Range("CI2").Value = "" Then
            MsgBox "no schedule/no jobs", vbExclamation
            Exit Sub
        End If
        
        ' 复制指定区域到主表
        .Range("CI2:CJ" & lastRowCI).Copy
        wsHeader.Range("A52").PasteSpecial Paste:=xlPasteValues
        
        ' 处理CK2开始的数据复制
        lastColCK = .Range("CK2").End(xlToRight).Column
        lastRowCK = .Cells(.Rows.Count, "CK").End(xlUp).Row
        
        .Range(.Cells(2, "CK"), .Cells(lastRowCK, lastColCK)).Copy
        wsHeader.Range("F52").PasteSpecial Paste:=xlPasteValues
    End With
    
    ' 取消复制模式
    Application.CutCopyMode = False
    
    ' 定位到指定区域
    wsHeader.Range("H1:V6").Select
End Sub

关键修改点说明 #

• 移除Select/Activate操作：通过定义wsHeader和wsZone变量直接操作工作表，代码更高效、稳定，避免切换工作表的冗余操作。
• 精准获取数据范围：用Cells(Rows.Count, 列标识).End(xlUp).Row从工作表底部往上查找最后一行有数据的单元格，不会出现单一行数据时选中大量空单元格的问题。
• 增加空数据检测：判断目标起始单元格或列是否无数据，弹出提示并终止宏，符合需求。
• 安全清除数据：清除主表数据前先判断起始单元格是否有值，避免误操作空区域。

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