如何用Excel VBA编写循环实现多工作表多表格批量复制粘贴

你只需要将两组变量按一一对应的顺序存入两个长度相同的数组，通过索引对齐的方式同步遍历即可，完整实现代码如下：

' 第一步：定义两个对应数组，严格保持顺序：第N个通用名称对应第N个目标工作表名称
Dim arrQ(1 To 11) As String, arrQs(1 To 11) As String
' 给数组赋值，顺序必须和你的变量对应关系一致
arrQ(1) = Q1: arrQs(1) = Q1s
arrQ(2) = Q2: arrQs(2) = Q2s
arrQ(3) = Q3: arrQs(3) = Q3s
arrQ(4) = Q4: arrQs(4) = Q4s
arrQ(5) = Q5: arrQs(5) = Q5s
arrQ(6) = Q6: arrQs(6) = Q6s
arrQ(7) = Q7: arrQs(7) = Q7s
arrQ(8) = Q8: arrQs(8) = Q8s
arrQ(9) = Q9: arrQs(9) = Q9s
arrQ(10) = Q10: arrQs(10) = Q10s
arrQ(11) = Q11: arrQs(11) = Q11s

' 第二步：按索引同步遍历两个数组执行操作
Dim i As Integer
For i = 1 To 11
    ' 取出当前组的对应名称
    Dim curQ As String, curQs As String
    curQ = arrQ(i)
    curQs = arrQs(i)
    
    ' 执行你原来的单组逻辑
    With DestWbk.Sheets(curQs).ListObjects(curQ)
        If .ListRows.Count > 0 Then
            .DataBodyRange.Delete
        End If
    End With
    SrcWbk.Sheets(curQ).Range(curQ).Copy DestWbk.Sheets(curQs).Range(curQ)
Next i

注意事项 #

• 两个数组的赋值顺序必须严格对应，比如arrQ(1)存的是Q1，arrQs(1)就必须存对应的Q1s，否则会出现操作错位的问题
• 这里使用1基数组是为了和你1~11的变量序号对应，更容易核对顺序，不需要额外处理索引偏移
• 如果后续需要新增/减少操作的表格，只需要调整数组长度和对应赋值即可，不需要修改循环逻辑

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