基于工作表名称含US的Excel VBA数据编译代码需求

以下是修改后的代码，将按工作表名称（包含“US”）而非位置筛选目标表，同时移除了不稳定的Select/Activate操作：

Public Sub Compiler()
    Dim ws As Worksheet
    Dim NEWROW As Long
    Dim dataRange As Range
    Dim Therapyname As Variant, Therapyname_ As Variant ' 保留原变量，供后续可能的使用
    
    ' 遍历工作簿中所有工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 检查工作表名称是否包含“US”（不区分大小写）
        If InStr(1, ws.Name, "US", vbTextCompare) > 0 Then
            ' 获取汇总表F列的下一个空行
            NEWROW = CompiledSheet.Cells(CompiledSheet.Rows.Count, "F").End(xlUp).Row + 1
            
            ' 读取疗法名称（原代码未使用，保留以备后续需求）
            Therapyname = ws.Range("B3").Value
            Therapyname_ = ws.Range("B2").Value
            
            ' 定义需要复制的数据范围：从B6开始到最后一行最后一列
            Set dataRange = ws.Range("B6", ws.Range("B6").End(xlToRight).End(xlDown))
            
            ' 复制值和数字格式到汇总表，无需选中任何单元格
            dataRange.Copy
            CompiledSheet.Cells(NEWROW, "F").PasteSpecial xlPasteValuesAndNumberFormats
        End If
    Next ws
    
    ' 清除剪贴板，避免残留复制状态
    Application.CutCopyMode = False
End Sub

核心改进点： #

• 按名称筛选工作表：使用InStr函数检测工作表名称是否包含“US”，vbTextCompare参数实现不区分大小写匹配（若需严格区分大小写，可移除该参数）。
• 移除Select/Activate：直接通过工作表变量引用单元格范围，提升代码运行速度，同时避免因用户操作切换工作表导致的错误。
• 明确范围定义：直接指定数据范围，替代依赖选中操作的模糊范围选择，逻辑更清晰可靠。
• 剪贴板清理：添加Application.CutCopyMode = False，避免代码运行后剪贴板残留复制状态。

注意事项： #

• 确保CompiledSheet已正确声明和赋值（例如：Dim CompiledSheet As Worksheet 后接 Set CompiledSheet = ThisWorkbook.Worksheets("你的汇总表名称")，若原代码已定义可忽略）。
• 若目标数据区域存在空行/空列，可调整范围定义逻辑，例如使用ws.Cells(ws.Rows.Count, "B").End(xlUp).Row获取B列最后一行，确保数据范围准确。

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