如何通过工作表列表将指定单元格区域复制到多个工作表

我们可以修改宏代码，让它自动读取第一个工作表中B1:B10的目标工作表名称列表，无需每次手动修改代码里的工作表名。修改后的宏会遍历列表中的每个名称，将CITIES区域复制到对应工作表的C1单元格位置。

修改后的宏代码 #

Sub CITIES_COPY()
    Dim sourceRange As Range
    Dim targetSheetName As Range
    Dim ws As Worksheet
    Dim mainWs As Worksheet
    
    ' 指定第一个工作表为主工作表（存放CITIES和目标列表的表）
    Set mainWs = ThisWorkbook.Worksheets(1)
    ' 获取要复制的CITIES区域
    Set sourceRange = mainWs.Range("CITIES")
    
    ' 遍历B1:B10中的每个工作表名称
    For Each targetSheetName In mainWs.Range("B1:B10")
        ' 跳过空单元格，避免无效操作
        If targetSheetName.Value <> "" Then
            ' 处理可能存在的不存在的工作表名称，防止宏报错
            On Error Resume Next
            Set ws = ThisWorkbook.Worksheets(targetSheetName.Value)
            On Error GoTo 0
            
            ' 如果找到对应的工作表，执行复制操作
            If Not ws Is Nothing Then
                sourceRange.Copy Destination:=ws.Range("C1")
                Set ws = Nothing ' 释放对象内存
            End If
        End If
    Next targetSheetName
    
    ' 清除复制状态，回到主工作表的A1单元格
    Application.CutCopyMode = False
    mainWs.Range("A1").Select
End Sub

代码说明 #

• 自动读取目标列表：通过For Each循环遍历B1:B10区域，自动获取每次更新后的目标工作表名称，无需手动修改代码。
• 容错处理：加入空值检查和错误捕获，避免列表中出现空单元格或不存在的工作表名称时导致宏运行失败。
• 高效操作：直接通过对象操作完成复制（sourceRange.Copy Destination:=...），替代原代码的Select/Activate操作，运行更稳定高效。

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