VBA中使用.CopyPicture复制可变数据范围仅复制空白单元格求助

我有一个工作表A（对应代码里的Sheet18），数据范围是B1:J43。现有代码从另一工作表B复制数据到A的特定行，B列存储物理位置参考的通道编号，另有代码按H列条件对数据排序。尝试用.CopyPicture复制B1至J列最后有数据行的范围，但代码仅复制一个空白单元格，需要解决这个问题。

原代码：

Sub Snip_SDT_Sort()

Dim SDTLR

SDTLR = Worksheets("SDT Status").Cells(Sheet18.Rows.Count, "H").End(xlUp).Row + 1

    With Sheet18
        .Range("B" & SDTLR).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    End With

End Sub

注：B1:J1为表头行，B1:B43始终有数据，期望生成B1至J列最后使用行的数据截图。

问题出在哪 #

1. 工作表引用混乱：计算SDTLR时同时混用了Worksheets("SDT Status")和Sheet18两个工作表，逻辑错误；而且+1会指向最后有数据行的下一行，这行本身是空白的，自然复制不到内容。
2. 范围仅选单个单元格：原代码只指定了B列的单个单元格，根本没覆盖到J列，完全不符合你要复制整个区域的需求。

修正后的代码 #

Sub Snip_SDT_Sort()
    Dim lastRow As Long
    Dim targetSheet As Worksheet
    
    ' 绑定目标工作表（即你说的工作表A）
    Set targetSheet = Sheet18
    
    ' 取J列最后有数据的行——如果想基于B列（B1:B43始终有数据），就把"J"改成"B"
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "J").End(xlUp).Row
    
    ' 兜底：如果J列没数据，至少保留表头行
    If lastRow < 1 Then lastRow = 1
    
    ' 复制B1到J[lastRow]的完整区域为图片
    targetSheet.Range("B1:J" & lastRow).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Sub

关键调整说明 #

• 明确绑定目标工作表，避免跨表引用的逻辑错误，确保lastRow是你要截图的工作表的最后数据行。
• 把范围改成B1:J" & lastRow，直接覆盖你需要的整个数据区域，而不是单个单元格。
• 加了lastRow的兜底判断，防止J列无数据时出现运行错误。
• 如果你想基于B列的行（因为B列始终有数据），只需要把计算lastRow时的"J"改成"B"即可，更贴合你的实际场景。

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