VBA代码无法正常运行

时间:2015-08-19 14:38:59

标签: excel vba excel-vba autofilter

我正在尝试编写一个通用代码,我可以将其复制并粘贴到我的任何报告中(它们都是相同的报告,它们只需要每天运行)。它本质上是一种格式化和删除不必要数据的报告。当我最初编写代码时它工作得很好但是当我将它粘贴到另一个工作簿时它运行正常。它仍然会格式化并为某些事物分配特殊值,但它不会删除我不想要的值!有谁知道为什么会这样?

这是我的代码(请注意,它可能不是最有效的编码方法,但我只是新手:))

Sub NewFilter()
Dim wbI As Workbook, wb0 As Workbook
Dim wsI As Worksheet, ws0 As Worksheet
Dim myRange As Range
Dim outputRange As Range, endoRange
Dim nfRange As Range
Dim i As Long, j As Long


'Establish my source of info worbooks and worksheet
Set wbI = ThisWorkbook
Set wsI = wbI.Sheets("Sheet1")

'Filters Original wb by criteria
'Selection.AutoFilter
ActiveSheet.Range("A1").AutoFilter Field:=5, Criteria1:=Array( _
    "Gur Insurance Plan 1", "Gur Insurance Plan 2", "Gur Insurance Plan 3", _
    "Gur Insurance Plan 4", "Gur Insurance Pol No 1", "Gur Insurance Pol No 2", _
    "Gur Insurance Pol No 3"), Operator:=xlFilterValues

'Establish and create new worbook where I will output my info
Set wb0 = Workbooks.Add

With wb0

'Save new workbook
Set ws0 = wb0.Sheets("Sheet1")
.SaveAs Filename:="New Soarian Test"

'Copy all visible cells in original workbook
wsI.Cells.Copy

'Paste values and formatting rules into new workbook
ws0.Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
ws0.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
End With

'Add a new column into A called "Rep"
ws0.Columns("A:A").Insert Shift:=xlToRight,         CopyOrigin:=xlFormatFromLeftOrAbove
ws0.Range("A1").Value = "Rep"

**'Filter Soarian Column by "Approved"
Selection.AutoFilter
ws0.Range("A1").AutoFilter Field:=7, Criteria1:=Array( _
     "APPROVED"), Operator:=xlFilterValues
If ws0.Range("E1:E1000").SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then**

'Select and delete cells then unfilter all
ws0.Range("A2:I1000").SpecialCells(xlCellTypeVisible).Select
Application.DisplayAlerts = False
Selection.Delete
Application.DisplayAlerts = True
ws0.AutoFilterMode = False

Else

ws0.AutoFilterMode = False

End If

**'Filter EncProv by Clincal Psych and Physcial Therapy
ws0.Range("A1").AutoFilter Field:=3, Criteria1:=Array( _
     "PHYSICAL THERAPY", "CLINIC PSYCH OUTPAT"), Operator:=xlFilterValues

If ws0.Range("C1:C1000").SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
'Select visible cells and delete them and then unfilter
ws0.Range("A2:I1000").SpecialCells(xlCellTypeVisible).Select
Application.DisplayAlerts = False
Selection.Delete
Application.DisplayAlerts = True
Else
ws0.AutoFilterMode = False
End If**

基本上我只是在我过滤掉它时才能删除我的“已批准”,临床治疗和物理治疗值。但它在我编写代码的原始工作簿中有效。任何想法??

非常感谢!

0 个答案:

没有答案