excel中使用VBA复制目标工作表A10:H10+H列并保留公式

本文链接：https://blog.youkuaiyun.com/weixin_47771206/article/details/131637130

本文展示了如何使用VBA宏在Excel中自动将公式从一个或两个指定的工作表复制到其他所有工作表的特定区域。宏包括两个子程序，一个用于复制A10:H10的公式，另一个用于复制整个H列的公式直到最后一行，并将它们粘贴到其他工作表相应的位置。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

打开Excel文件，按下Alt + F11打开Visual Basic for Applications（VBA）编辑器。
在VBA编辑器中，插入一个新的模块。右键点击项目资源管理器中的"Microsoft Excel 对象"，选择"插入" -> “模块”。
在模块中，复制粘贴以下函数代码：

————————————————

Sub PasteFormulasToSheets()
    Dim ws As Worksheet
    Dim sourceSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    
    ' 设置源工作表
    Set sourceSheet = ThisWorkbook.Worksheets("2021.7")#原表
    
    ' 设置源范围（A10:H10）
    Set sourceRange = sourceSheet.Range("A10:H10")
    
    ' 循环遍历除第一个工作表外的其他工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index <> 1 Then
            ' 设置目标范围（A10:H10）
            Set targetRange = ws.Range("A10:H10")
            
            ' 粘贴源范围的公式到目标范围
            targetRange.Formula = sourceRange.Formula
        End If
    Next ws
End Sub

Sub COPYFormulasToSheets()
    Dim ws As Worksheet
    Dim sourceSheet As Worksheet
    Dim lastRow As Long
    
    ' 设置源工作表
    Set sourceSheet = ThisWorkbook.Worksheets("2021.6")
    
    ' 获取源列的最后一行
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "H").End(xlUp).Row
    
    ' 循环遍历除第一个工作表外的其他工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index <> 1 Then
            ' 粘贴源列的公式到目标工作表的H列
            ws.Range("H1:H" & lastRow).Formula = sourceSheet.Range("H1:H" & lastRow).Formula
        End If
    Next ws
End Sub

更新一下，直接修改为第二个表

Sub PasteFormulasToSheets()
    Dim ws As Worksheet
    Dim sourceSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    
    ' 设置源工作表（第二个工作表，索引为2）
    Set sourceSheet = ThisWorkbook.Worksheets(2)
    
    ' 设置源范围（A10:H10）
    Set sourceRange = sourceSheet.Range("A10:H10")
    
    ' 循环遍历除第一个工作表外的其他工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index <> 1 Then
            ' 设置目标范围（A10:H10）
            Set targetRange = ws.Range("A10:H10")
            
            ' 粘贴源范围的公式到目标范围
            targetRange.Formula = sourceRange.Formula
        End If
    Next ws
End Sub


Sub COPYFormulasToSheets()
    Dim ws As Worksheet
    Dim sourceSheet As Worksheet
    Dim lastRow As Long
    
    ' 设置源工作表
     Set sourceSheet = ThisWorkbook.Worksheets(2)
    
    ' 获取源列的最后一行
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "H").End(xlUp).Row
    
    ' 循环遍历除第一个工作表外的其他工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Index <> 1 Then
            ' 粘贴源列的公式到目标工作表的H列
            ws.Range("H1:H" & lastRow).Formula = sourceSheet.Range("H1:H" & lastRow).Formula
        End If
    Next ws
End Sub