宏只复制可见单元格

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

如果这是可以接受只复制单元格值和公式（即无格式invisble ）你可以使用这个

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 

编辑
刚刚看到您的评论对尼科，看来你做也想要格式。一次复制一行的伎俩
我最初尝试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