如何修改Copysheets宏使其不复制隐藏行与列？

直接使用Worksheet.Copy方法会完整复制原工作表的所有属性，包括隐藏的行和列。要避免这个问题，我们可以改为仅复制原表的可见单元格区域到新工作簿，而非复制整个工作表。

以下是优化后的完整代码：

Sub CopySheetsWithoutHiddenRowsColumns()
    Dim wkb As Excel.Workbook
    Dim newWkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim newWks As Excel.Worksheet
    Dim sheets As Variant
    Dim varName As Variant
    Dim visibleRange As Range
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 指定要复制的工作表名称
    sheets = VBA.Array("TAB NAME")
    
    Set wkb = Excel.ThisWorkbook
    Set newWkb = Excel.Workbooks.Add
    
    ' 删除新工作簿默认创建的Sheet1
    newWkb.Worksheets("Sheet1").Delete
    
    For Each varName In sheets
        Set wks = Nothing
        On Error Resume Next
        Set wks = wkb.Worksheets(VBA.CStr(varName))
        On Error GoTo 0
        
        If Not wks Is Nothing Then
            ' 在新工作簿新建工作表并沿用原表名称
            Set newWks = newWkb.Worksheets.Add
            newWks.Name = wks.Name
            
            ' 定位原表已使用区域中的可见单元格
            Set visibleRange = wks.UsedRange.SpecialCells(xlCellTypeVisible)
            
            ' 复制可见区域到新工作表的起始位置
            visibleRange.Copy
            ' 可根据需求调整粘贴类型：xlValues仅粘贴值，xlPasteAllUsingSourceTheme保留格式
            newWks.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            newWks.Range("A1").Select
        End If
    Next varName
    
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

关键优化说明： #

• 移除原代码中wks.Copy的逻辑，改为手动新建工作表，从根源避免复制隐藏状态
• 用wks.UsedRange.SpecialCells(xlCellTypeVisible)精准筛选原表的可见单元格区域
• 提前删除新工作簿默认的Sheet1，简化后续操作逻辑
• 可灵活调整粘贴类型，匹配你对值/格式的需求

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