Excel VBA循环复制粘贴图片需求：求循环语句实现跨列重复操作

下面是针对你需求的完整VBA代码，保留了你熟悉的With语句，同时实现了间隔3列的循环复制逻辑：

Sub CopyPicLinks()
    Dim wsPic As Worksheet, wsPrnt As Worksheet
    Dim startCol As Integer, currentCol As Integer
    Dim lastCol As Integer
    Dim picLinkRange As Range ' PicPg中存放图片链接的指定单元格，按需修改
    
    ' 绑定目标工作表
    Set wsPic = ThisWorkbook.Worksheets("PicPg")
    Set wsPrnt = ThisWorkbook.Worksheets("PrntPg")
    
    ' 设置复制的起始列（比如从PrntPg的B列开始，对应数字2）
    startCol = 2
    currentCol = startCol
    
    ' 指定PicPg中要复制的图片链接单元格，这里假设是A1，根据你的实际位置改
    Set picLinkRange = wsPic.Range("A1")
    
    ' 查找PrntPg第1行中第一个包含"book"的列，作为循环终止条件
    On Error Resume Next
    lastCol = wsPrnt.Rows(1).Find(What:="book", LookIn:=xlValues, LookAt:=xlPart).Column
    On Error GoTo 0
    
    ' 如果没找到"book"，就以第1行最后一个非空列作为终止点
    If lastCol = 0 Then
        lastCol = wsPrnt.Cells(1, wsPrnt.Columns.Count).End(xlToLeft).Column
    End If
    
    ' 循环执行间隔复制
    With wsPrnt
        Do While currentCol < lastCol
            ' 把图片链接复制到当前列的目标行（这里是第2行，按需修改行号）
            .Cells(2, currentCol).Value = picLinkRange.Value
            ' 跳转到下一个间隔3列的位置
            currentCol = currentCol + 3
        Loop
        ' 确保最后一个符合条件的列也被复制
        If currentCol <= lastCol Then
            .Cells(2, currentCol).Value = picLinkRange.Value
        End If
    End With
    
    ' 释放对象
    Set wsPic = Nothing
    Set wsPrnt = Nothing
    Set picLinkRange = Nothing
    
    MsgBox "图片链接复制完成！"
End Sub

关键参数修改提示 #

• 图片链接源单元格：把wsPic.Range("A1")改成你实际存放图片链接的单元格（比如wsPic.Range("C3")）。
• 复制起始列：startCol = 2对应B列，改成你需要的起始列数字即可。
• 目标行：.Cells(2, currentCol)中的2是复制到PrntPg的第2行，按需修改行号。
• "book"匹配规则：如果需要精确匹配（必须完全是"book"才终止），把LookAt:=xlPart改成LookAt:=xlWhole。

代码逻辑说明 #

1. 先绑定两个工作表对象，减少重复引用的麻烦；
2. 自动找到第1行中包含"book"的列作为终止点，找不到就用最后一个非空列；
3. 用Do While循环实现间隔3列的复制，每次复制后列数+3；
4. 最后额外判断一次，避免最后一个符合条件的列被遗漏；
5. 释放对象避免内存占用，最后弹出完成提示。

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