如何编辑以下 Copysheets 宏以不复制隐藏的列/行？

Question

我有一个宏，用于将工作表复制到新工作簿中。我遇到的唯一问题是，当它将工作表复制到新工作簿中时，它会复制隐藏的列/行。更新宏以使其不会复制隐藏的列/行的最佳方法是什么？

Sub CopySheets()
    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 i As Integer
    '------------------------------------------------------------
    Application.ScreenUpdating = False

    'Define the names of worksheets to be copied.
    sheets = VBA.Array("TAB NAME")


    'Create reference to the current Excel workbook and to the destination workbook.
    Set wkb = Excel.ThisWorkbook
    Set newWkb = Excel.Workbooks.Add


    For Each varName In sheets

        'Clear reference to the [wks] variable.
        Set wks = Nothing

        'Check if there is a worksheet with such name.
        On Error Resume Next
        Set wks = wkb.Worksheets(VBA.CStr(varName))
        On Error GoTo 0


        'If worksheet with such name is not found, those instructions are skipped.
        If Not wks Is Nothing Then

            'Copy this worksheet to a new workbook.
            Call wks.Copy(newWkb.Worksheets(1))

            'Get the reference to the copy of this worksheet and paste
            'all its content as values.
            Set newWks = newWkb.Worksheets(wks.Name)
            With newWks
                Call .Cells.Copy
                Call .Range("A1").PasteSpecial(Paste:=xlValues)
                Call .Range("A1").Select
            End With

        End If
        
        'Delete Sheet1 from new workbook    
    Application.DisplayAlerts = False
        For i = newWkb.Worksheets.Count To 2 Step -1
        newWkb.Worksheets(i).Delete
        Next i
    Application.DisplayAlerts = True

    Next varName
    
    Application.ScreenUpdating = True
End Sub

Answer 1

排除隐藏行

• 尝试以下操作。 未测试！

        Dim nrg As Range
        Dim nRowsCount As Long

        Set newWks = newWkb.Worksheets(wks. Name)

        With newWks.UsedRange
            Set nrg = .SpecialCells(xlCellTypeVisible)
            nRowsCount = Intersect(nrg, newWks.Columns(nrg.Column)).Cells.Count
            nrg.Copy
            .Range("A1").PasteSpecial Paste:=xlValues
            .Resize(.Rows.Count - nRowsCount).Offset(nRowsCount).Clear
            Application.Goto .Range("A1")
        End With