在Excel VBA中自动生成电子表格

我的朋友和我目前有一个主电子表格,我需要定期分解成更小的电子表格。 这曾经是一个手动过程,但我想自动化它。 我在VBA中创build了三步解决scheme,这将帮助我完成以下工作:

  1. 将相关filter应用于电子表格
  2. 将当前可见的数据导出到新的电子表格中
  3. 保存电子表格并返回到1(不同的标准)

不幸的是我很难实施它。 每当我尝试生成电子表格,我的文档挂起,开始执行几个计算,然后给我这个错误信息:

在这里输入图像说明

在debugging代码时,我在这一行收到一条错误消息:

在这里输入图像说明

一个Excel工作簿保持打开,只有一行是可见的(第二行从包含标题信息的主文件中拉出),而没有其他的东西。

这到底是怎么回事?

这是我的代码到目前为止:

这一切的核心

' This bit of code get's all the primary contacts in column F, it does ' this by identifying all the unique values in column F (from F3 onwards) Sub GetPrimaryContacts() Dim Col As New Collection Dim itm Dim i As Long Dim CellVell As Variant 'Get last row value LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row 'Loop between all column F to get unique values For i = 3 To LastRow CellVal = Sheets("Master").Range("F" & i).Value On Error Resume Next Col.Add CellVal, Chr(34) & CellVal & Chr(34) On Error GoTo 0 Next i ' Once we have the unique values, apply the TOKEN NOT ACTIVATED FILTER Call TokenNotActivated For Each itm In Col ActiveSheet.Range("A2:Z2").Select Selection.AutoFilter Field:=6, Criteria1:=itm ' This is where the magic happens... creating the individual workbooks Call TokenNotActivatedProcess Next ActiveSheet.AutoFilter.ShowAllData End Sub 

“令牌未激活”filter

 Sub TokenNotActivated() 'Col M = Yes 'Col U = provisioned ThisWorkbook.Sheets(2).Activate ActiveSheet.Range("A2:Z2").Select Selection.AutoFilter Field:=13, Criteria1:="Yes" Selection.AutoFilter Field:=21, Criteria1:="provisioned", Operator:=xlFilterValues End Sub 

运行该过程以保存工作簿

 Function TokenNotActivatedProcess() Dim r As Range, n As Long, itm, FirstRow As Long n = Cells(Rows.Count, 1).End(xlUp).Row Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible) FirstRow = ActiveSheet.Range("F2").End(xlDown).Row itm = ActiveSheet.Range("F" & FirstRow).Value If r.Count - 2 > 0 Then Debug.Print itm & " - " & r.Count - 2 Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Workbooks.Add ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.SaveAs Filename:="C:\Working\Testing\TokenNotActivated - " & itm + ".xls", FileFormat:=52, CreateBackup:=False End Function 

这个错误是由于尝试过滤一个空的范围造成的。 在分析你的代码之后,我的猜测是你缺less一个工作表激活在这里,因为重复行ActiveSheet.Range("A2:Z2").Select调用函数TokenNotActivated后没有意义,也许你的代码试图过滤一些空的范围/工作表。