如何用VBA将工作表单元格图片复制粘贴到另一工作表单元格

你的VBA脚本在迁移已完成任务（状态为Cerrado）时，图片无法正确粘贴到目标表格对应行，主要是以下几个代码问题导致的：

核心问题点 #

• 缺失源工作表对象定义：遍历源表图片时用到的wsSrc没有赋值，代码根本找不到要复制的图片。
• 图片匹配逻辑不精准：仅用Intersect(img.TopLeftCell, srcCell)判断归属，要是图片左上角不在目标单元格里，就匹配不到。
• 未定义变量触发错误：MsgBox hi里的hi没定义，运行到这里会直接报错中断流程。
• 源行清理步骤缺失：原代码没删除源表中已完成的行，不符合“清理已完成任务”的需求。

修复后的完整代码 #

' 定位源表格的状态列
statusColumn = Application.Match("ESTATUS", srcTable.HeaderRowRange, 0) ' 列标题不同的话自行调整

' 补充源工作表定义（关键！之前没这行导致找不到图片）
Set wsSrc = srcTable.Parent
Set wsDes = ThisWorkbook.Sheets(sheetName & "Completados")
Set destTable = wsDes.ListObjects("Tabla" & sheetName & "Completados") ' 替换成你的目标表格名称

' 倒序遍历源表行（避免删除行导致索引混乱）
For i = srcTable.ListRows.Count To 1 Step -1
    Set srcRow = srcTable.ListRows(i)
    If srcRow.Range(1, statusColumn).Value = "Cerrado" Then
        hadCompleted = True
        
        ' 给目标表新增行
        Set destRow = destTable.ListRows.Add
        
        ' 复制整行数据
        destRow.Range.Value = srcRow.Range.Value
        
        ' 处理IMAGEN列的图片/批注
        commentColumnIndex = Application.Match("IMAGEN", srcTable.HeaderRowRange, 0)
        Set srcCell = srcRow.Range.Cells(1, commentColumnIndex)
        Set destCell = destRow.Range.Cells(1, commentColumnIndex)
        
        ' 处理批注情况
        If Not srcCell.Comment Is Nothing Then
            srcCell.Copy
            destCell.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
                                 SkipBlanks:=False, Transpose:=False
            srcCell.Comment.Delete
            MsgBox "批注已复制完成" ' 替换未定义的hi
        Else
            ' 遍历源表所有图片
            For Each img In wsSrc.Shapes
                ' 精确匹配图片所属单元格：左上角单元格地址一致
                If img.TopLeftCell.Address = srcCell.Address Then
                    img.Copy
                    
                    ' 确保粘贴到正确位置：激活目标表并选中目标单元格
                    wsDes.Activate
                    destCell.Select
                    wsDes.Paste
                    
                    ' 调整刚粘贴的图片位置和属性
                    Set pastedImg = wsDes.Shapes(wsDes.Shapes.Count)
                    If Not pastedImg Is Nothing Then
                        With pastedImg
                            .Top = destCell.Top
                            .Left = destCell.Left
                            .Width = destCell.Width
                            .Height = destCell.Height
                            .Placement = xlMoveAndSize ' 图片随单元格联动
                        End With
                    End If
                    
                    ' 删除源图片（按需启用）
                    img.Delete
                End If
            Next img
        End If
        
        ' 删除源表中已处理的完成行
        srcRow.Delete
    End If
Next i

修复说明 #

1. 补上wsSrc定义：通过srcTable.Parent直接获取源表格所在的工作表，不用手动指定，更灵活。
2. 精准匹配图片：用单元格地址对比替代Intersect，确保只有属于当前任务行的图片才会被复制。
3. 修复错误提示：把无意义的MsgBox hi改成明确的提示，避免运行报错。
4. 添加源行删除：完成迁移后删除源表的对应行，实现“清理已完成任务”的核心需求。
5. 优化粘贴位置：激活目标表并选中目标单元格，解决图片粘贴位置偏移的问题。

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