VBA,高级筛选器不工作W /空白表

我得到了下面的macros,但是当我运行它的一些文件只有标题,没有下面,我明显得到一个错误,因为我改变它不包括头。

是否有任何解决方法可能填充“N / A”,而不是得到这个错误? 我可以使用任何代码将N / A放在某些列中空白的整个工作簿中? 或任何想法?

Sub GetUniqueValues() Dim wks As Excel.Worksheet Dim wksSummary As Excel.Worksheet '---------------------------------------------------------------------------------- 'edited so it shows in the 3rd column row +1. Add the header and sheet name macro to this On Error Resume Next Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data") On Error GoTo 0 If wksSummary Is Nothing Then Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add wksSummary.Name = "Unique data" End If 'Iterate through all the worksheets, but skip [Summary] worksheet. For Each wks In Excel.ActiveWorkbook.Worksheets With wksSummary If wks.Name <> .Name Then If Application.WorksheetFunction.CountA(wks.Range("C:C")) Then Dim r As Range ' Get the first cell of our destination range... Set r = .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row + 1, 3) ' Perform the unique copy... wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True ' Remove the first cell at the destination range... r.Delete xlShiftUp End If End If End With Next wks 'Headers Range("A1").Value = "File Name " Range("B1").Value = "Sheet Name " Range("C1").Value = "Column Name" Dim intRow As Long: intRow = 2 For i = 1 To Sheets.Count If Sheets(i).Name <> ActiveSheet.Name Then Cells(intRow, 2) = Sheets(i).Name Cells(intRow, 1) = ActiveWorkbook.Name intRow = intRow + 1 End If Next i End Sub 

更换

 wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True 

有:

 If WorksheetFunction.CountA(wks.Range("C:C")) > 1 Then wks.Range("C:C").AdvancedFilter xlFilterCopy, , r, True End If