在最后一张工作表之后将值复制到新工作表，如果为空则删除列 b答案

【问题标题】：Copy values to new sheet after the last sheet and delete column b if empty在最后一张工作表之后将值复制到新工作表，如果为空则删除列 b
【发布时间】：2013-04-19 20:56:45
【问题描述】：

我只想复制运行宏的任何工作簿的最后一张工作表的值（不是公式）（我不知道工作表的名称或工作表的数量），如果 B 列为空，则删除它并将这个新工作表命名为“游戏”。这就是我所拥有的，但它不起作用=(。有人可以帮我吗？

Sub ArrumarTabela()
    ActiveSheet.Copy
    Cells.Copy

    Application.CutCopyMode = False
    ActiveSheet.Name = "Games"
    Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.ScreenUpdating = False

    ActiveSheet.Name = "Games"

    Dim cl As Range
    For Each cl In Range("$B$2:$B" & Range("$B$65536").End(xlUp).Row)
        If cl = "" Then cl.EntireColumn.Delete
    Next cl

    Range("C1").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

    Application.ScreenUpdating = True
End Sub

【问题讨论】：

Application.CutCopyMode = False 这将清除剪贴板...那么您将如何粘贴？
如 sid 所说。您应该删除 cutcopymode = false

标签： excel vba

【解决方案1】：

这个修改能满足你的需要吗？

Sub ArrumarTabela()
    ActiveSheet.Copy 'this will create a new workbook and a new sheet with current

    With ActiveSheet
        .Name = "Games" 'change new sheets name

        .Cells.Copy 'copy all cells
        .Range("A1").PasteSpecial Paste:=xlPasteValues 'paste only values
        .ScreenUpdating = False

        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row 'last row?

        Set cl = .Range("B2:B" & lastrow).Find("", lookat:=xlWhole) 'find a blank cell in a range

        If Not cl Is Nothing Then cl.EntireColumn.Delete 'delete column if blank exists

        .Range("C1").EntireColumn.Insert 'insert new column belfore column C

        .ScreenUpdating = True
    End With
End Sub

【讨论】：