Excel VBA批量将每行3个单元格复制为图片粘贴到另一工作表求助

每年教师都会集中制定下一学年的班级名单，目前该项工作通过便利贴完成。分班要求各班男女生人数、学业水平、行为表现水平分布均衡，避免出现某班聚集大量高行为需求学生的情况。
现有导出到Excel的全体学生数据，包含性别标注，教师会采用颜色编码为每名学生的学业表现、行为表现评级。需要将每一行学生对应的姓名、学业评级、行为评级所在3个单元格复制为Picture粘贴到Sheet2，方便教师后续在Sheet2中拖拽调整学生所属班级，直观查看各班性别、学业、行为表现的分布均衡情况。

Sub Macro1()
'
' Macro1 Macro
'
    Range("B2:D2").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Pictures.Paste.Select
End Sub

以下代码可自动遍历所有有数据的学生行，将对应单元格批量转为图片粘贴到Sheet2，且自动错位排列避免重叠：

Sub 批量生成学生信息卡片()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim pasteCol As Long
    Dim pasteRow As Long
    ' 配置源表和目标表，可根据实际表名修改
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    Set targetSheet = ThisWorkbook.Worksheets("Sheet2")
    ' 获取源表最后一行有数据的行号
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "B").End(xlUp).Row
    ' 粘贴起始位置配置
    pasteRow = 1
    pasteCol = 1
    
    For i = 2 To lastRow ' 假设第1行是表头，从第2行开始读取学生数据
        ' 复制当前行的姓名、学业评级、行为评级单元格
        sourceSheet.Range("B" & i & ":D" & i).Copy
        ' 粘贴为图片到目标表
        targetSheet.Select
        targetSheet.Cells(pasteRow, pasteCol).Select
        targetSheet.Pictures.Paste
        
        ' 调整下一个粘贴位置，每10个换列避免横向太长
        If (i - 1) Mod 10 = 0 Then
            pasteCol = pasteCol + 4 ' 列间隔4个单元格避免重叠
            pasteRow = 1
        Else
            pasteRow = pasteRow + 2 ' 行间隔2个单元格避免重叠
        End If
    Next i
    ' 清空剪切板
    Application.CutCopyMode = False
End Sub

• 请先确认源数据存放在Sheet1，B列为姓名、C列为学业评级、D列为行为评级，第1行为表头
• 运行宏前请确保已经新建Sheet2作为粘贴目标表
• 代码中行列偏移量、每列展示数量可根据实际使用需求调整

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