将值复制到上一个工作表之后的新工作表,如果列b为空,则删除列b



我只想复制任何工作簿的最后一张表的值(不是公式),我运行宏(我不知道表的名称或表的数量),并删除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

这个修改能满足您的需求吗?

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

最新更新