VBA删除所有数据

Question

我是vba的新手，并编写了一些代码来删除特定数据并刷新2个数据透视表。当我逐步浏览每个子菜单时，它工作正常，但是当我将模块添加到按钮中时，只要按一下按钮即可运行所有内容，

下面是我编写的代码（可能有点麻烦，但我仍在学习）。我希望有人能帮助我。

Sub Deleteheader()
    ActiveWindow.FreezePanes = False
    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
End Sub

Sub DeleteColumns()
    Dim wsAvlRpt As Worksheet, wsSetUp As Worksheet

    Set wsAvlRpt = ActiveWorkbook.Worksheets("AvlRpt")
    Set wsSetUp = ActiveWorkbook.Worksheets("SetUp")

    ColTotal = wsAvlRpt.UsedRange.Column + wsAvlRpt.UsedRange.Columns.Count - 1
    LastCol = Split(Cells(1, ColTotal).Address, "$")(1)
    For i = 1 To ColTotal
        ColumnName = wsAvlRpt.Cells(1, i)
        Values = wsSetUp.Range("A" & Rows.Count).End(xlUp).Row
        cntColName = Application.CountIf(wsSetUp.Range("A2:A" & Values), ColumnName)
        If cntColName = 0 Then
            wsAvlRpt.Columns(i).EntireColumn.Delete
            i = i - 1
            ColTotal = ColTotal - 1
        End If

        If ColTotal <= i Then
            Exit For
        End If
    Next i

    wsAvlRpt.Columns(7).EntireColumn.Insert
    wsAvlRpt.Range("G1").Value = "Item Desc"
    Columns("G:G").Select
    Selection.NumberFormat = "General"
End Sub

Public Sub DeleteStatus()
    Dim wsAvlRpt As Worksheet
    Dim lngLastRow As Long
    Dim rngAvl As Range

    Set wsAvlRpt = ThisWorkbook.Worksheets("AvlRpt")
    With wsAvlRpt
        lngLastRow = .Range("C" & .Rows.Count).End(xlUp).Row
        Set rngAvl = .Range("A2:J" & lngLastRow)
    End With

    Application.DisplayAlerts = False
    With rngAvl
        .AutoFilter field:=8, _
                    Criteria1:="Ongoing", _
                    Operator:=xlOr, _
                    Criteria2:="P.Label"
        .Offset(0).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).Rows.Delete
    End With
    Application.DisplayAlerts = True

    With wsAvlRpt
        .AutoFilterMode = False
        If .FilterMode = True Then
            .ShowAllData
        End If
    End With
End Sub

Sub DeleteZeroInventory()
    Dim wsAvlRpt As Worksheet, wsSetUp As Worksheet
    Set wsAvlRpt = ActiveWorkbook.Worksheets("AvlRpt")
    Set wsSetUp = ActiveWorkbook.Worksheets("SetUp")

    cntZeroInventory = Application.CountIf(wsAvlRpt.Range("I:I"), "<=0.0")
    If cntZeroInventory > 0 Then
        Total = wsAvlRpt.Cells(Rows.Count, "A").End(xlUp).Row
        wsAvlRpt.Range("$A1:J" & Total).AutoFilter field:=9, Criteria1:="<=0.0", _
                                                   Operator:=xlFilterValues
        wsAvlRpt.Range("A2:J" & Total).Select
        Selection.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        wsAvlRpt.ShowAllData

        wsAvlRpt.Columns(10).EntireColumn.Insert
        wsAvlRpt.Range("J1").Value = "Available Eaches"
    End If
End Sub

Sub CalcEaches()
    Dim LastRow As Long

    Sheets("AvlRpt").Activate
    LastRow = Range("I65536").End(xlUp).Row
    Range("I2:I" & LastRow).Select

    Selection.Offset(0, 1).Select
    Selection.FormulaR1C1 = "= RC[-1] *12"
    Selection = Selection.Value
End Sub

Sub AddItemDesc()
    With Sheets("AvlRpt")
        .Range("G2:G" & .Range("C" & Rows.Count).End(xlUp).Row).Formula = _
                  "=IF(ISERROR(VLOOKUP(C2,SetUp!I:J,2,FALSE)),0,VLOOKUP(C2,SetUp!I:J,2,FALSE))"
        .Range("G2:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value = _
                  .Range("G2:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    End With
End Sub

Sub DeleteStyles()
    Dim wsAvlRpt As Worksheet, wsSetUp As Worksheet

    Set wsAvlRpt = ActiveWorkbook.Worksheets("AvlRpt")

    Dim AvlRpt As Range
    Set AvlRpt = wsAvlRpt.Range("A1", Range("A1").End(xlDown).End(xlToRight))
    AvlRpt.AutoFilter field:=3, Criteria1:=Array("7A37", "8A37", "CO07", "CO81"), _
                      Operator:=xlFilterValues
    AvlRpt.CurrentRegion.Offset(1, 0).Select

    With Selection
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        If wsAvlRpt.FilterMode Then
            wsAvlRpt.ShowAllData
        End If
    End With
End Sub

Sub ClearContents()
    Worksheets("CloseoutData").Range("A2:J2000").Clear
End Sub

Sub CopyDeleteAvlRpt()
    Application.DisplayAlerts = False

    Sheets("AvlRpt").Range("A2:J2000").Copy _
        Destination:=Sheets("CloseoutData").Range("A2:J2000")
    Sheets("AvlRpt").Delete
    Application.DisplayAlerts = True
End Sub

Sub RefreshPivots()
    ThisWorkbook.RefreshAll
End Sub

Sub PivotCopyAdults()
    Dim pt As PivotTable, lRow As Long
    Dim oWS_Copy As Worksheet, oWS_Paste As Worksheet

    Set oWS_Copy = Sheets("Adults")
    Set oWS_Paste = Sheets.Add
    ActiveSheet.Name = "CloseOuts Adults"

    For Each pt In oWS_Copy.PivotTables
        pt.TableRange2.Copy
        lRow = oWS_Paste.Cells(Rows.Count, 1).End(xlUp).Row + 1
        oWS_Paste.Range("A" & lRow).PasteSpecial Paste:=xlPasteValues
        oWS_Paste.Range("A" & lRow).PasteSpecial Paste:=xlPasteFormats
    Next pt
    oWS_Paste.Cells.Columns.AutoFit
End Sub

Sub PivotCopyYouthLadies()
    Dim pt As PivotTable, lRow As Long
    Dim oWS_Copy As Worksheet, oWS_Paste As Worksheet

    Set oWS_Copy = Sheets("Youth&Ladies")
    Set oWS_Paste = Sheets.Add
    ActiveSheet.Name = "CloseOuts Youth & Ladies"

    For Each pt In oWS_Copy.PivotTables
        pt.TableRange2.Copy
        lRow = oWS_Paste.Cells(Rows.Count, 1).End(xlUp).Row + 1
        oWS_Paste.Range("A" & lRow).PasteSpecial Paste:=xlPasteValues
        oWS_Paste.Range("A" & lRow).PasteSpecial Paste:=xlPasteFormats
    Next pt
    oWS_Paste.Cells.Columns.AutoFit
End Sub