宏仅复制可见单元格

Question

宏仅复制已过滤行的可见单元格，但我不使用仅复制可见单元格。如何使我的宏复制所有单元格虽然它们在工作表中不可见

非常感谢任何帮助

由于

Answer 1

尼科，

在这种情况下，只需复制工作表并进行两次删除，代码将立即运行。如果您的最后一行位置未知，那么我可以调整此代码以找到真正的最后一行

Sub QuickKill()
    Application.ScreenUpdating = False
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .AutoFilterMode = False
        .Rows("1:1499").Delete
        .Rows("2001:30000").Delete
    End With
    Application.ScreenUpdating = True
End Sub

Answer 2

如果只复制单元格值和公式（即没有格式化），则可以使用此

Sub CopyAllData()
    Dim v As Variant
    Dim rngFrom As Range
    Dim rngTo As Range

    ' set a reference to the range to be copied, eg
    Set rng = [2:8]
    ' get the data
    v = rng.Formula

    ' set a range to the desitination, eg
    Set rngTo = [8:12]
    ' put the data
    rngTo.Formula = v

End Sub

修改
刚刚看到你对niko的评论，似乎你做也想要格式。一次复制一行就可以了 我最初尝试rngTo.Hidden = FALSE而不是rngTo.RowHeight = 15，但它返回错误，不知道为什么

Sub CopyAll()
    Dim rngFrom As Range
    Dim rngTo As Range
    Dim i As Long
    Dim sh As Worksheet
    Dim OldCalc As XlCalculation

    On Error GoTo Cleanup

    OldCalc = Application.Calculation
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' set a reference to the range to be copied, eg
    Set rngFrom = [2:12]

    ' set a range to the desitination first row, eg
    Set sh = Worksheets("Sheet2")
    Set rngTo = sh.[2:2]

    ' copy each row in turn and restore the copied row height
    For i = 1 To rngFrom.Rows.Count
        rngFrom.Rows(i).Copy rngTo
        rngTo.RowHeight = 15
        Set rngTo = rngTo.Offset(1, 0)
    Next

Cleanup:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = OldCalc

End Sub