Excel VBA按周数控列显隐后复制可见单元格至新表为空问题

导致新表为空的核心原因 #

1. 输入"all"时直接终止程序：原代码在输入"all"后执行Exit Sub，跳过了后续创建新表并复制内容的所有步骤，这是最直接的问题。
2. 最后一列取值逻辑错误：通过Range("CA7").Select再End(xlToLeft)获取最后一列，会错误识别最后一个连续可见列，而非工作表实际使用的最后一列，导致复制范围为空或不准确。
3. 依赖ActiveSheet易出错：未明确指定操作的数据源工作表，一旦当前激活的不是目标表，所有操作都会跑偏。

修复后的完整代码 #

Sub ShowColumnsAndCopy()
    Dim wsSource As Worksheet
    ' 替换成你的数据源工作表名称，比如"数据汇总"
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取用户输入
    Dim weekNumber As Variant
    weekNumber = InputBox("输入周数（1-49）或输入'all'显示所有列：")
    
    ' 验证输入有效性
    If Not (IsNumeric(weekNumber) And weekNumber >= 1 And weekNumber <= 49) And weekNumber <> "all" Then
        MsgBox "输入无效，请重新输入"
        Exit Sub
    End If
    
    ' 先取消所有列隐藏，统一初始化状态
    wsSource.Columns.Hidden = False
    
    ' 仅在输入具体周数时，隐藏不符合条件的列
    If weekNumber <> "all" Then
        Dim col As Integer
        ' 遍历第10列到第79列（对应J到CU列）
        For col = 10 To 79
            ' 检查第7行的列标题是否匹配目标周数
            If wsSource.Cells(7, col).Value <> "RAP Week " & weekNumber _
                And wsSource.Cells(7, col).Value <> "Inventaire Week " & weekNumber _
                And wsSource.Cells(7, col).Value <> "EDI Week " & weekNumber Then
                wsSource.Columns(col).Hidden = True
            End If
        Next col
    End If
    
    ' 获取第7行实际使用的最后一列
    Dim lastColumn As Integer
    lastColumn = wsSource.Cells(7, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 获取要复制的可见区域，添加错误处理避免无内容时报错
    Dim rngCopy As Range
    On Error Resume Next
    Set rngCopy = wsSource.Range(wsSource.Cells(7, 1), wsSource.Cells(wsSource.Rows.Count, lastColumn).End(xlUp)).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 检查是否有可复制内容
    If rngCopy Is Nothing Then
        MsgBox "没有可见内容可复制"
        Exit Sub
    End If
    
    ' 创建新工作表并复制内容
    Dim newSheet As Worksheet
    Set newSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    newSheet.Name = "Week " & weekNumber & " Results"
    
    ' 复制值和格式，避免剪贴板残留
    rngCopy.Copy
    newSheet.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

关键修复说明 #

• 删掉了all分支里的Exit Sub，确保无论输入周数还是all，都会执行复制步骤。
• 明确指定数据源工作表，彻底避免ActiveSheet带来的不确定性。
• 修正最后一列的获取方式，从第7行最右侧向左查找，得到真实的最后使用列。
• 增加错误处理，防止无可见单元格时代码崩溃。
• 把While循环改成更直观的For循环，逻辑更清晰。

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