从工作表中select特定的列以保存

我正在与我们正在应用多个filter的电子表格上的朋友合作。

第一个filter运行在列M和U上：

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

第二个filter对列F起作用，过滤在那里find的每个唯一值

例如

将返回作为约翰，莎拉，弗兰克filter。 此外，如果在运行第一组filter后没有find其中任何一行的行，则会跳过它。 负责这个的代码如下：

 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 rows 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 ' Create workbooks - Token Not activated Call TokenNotActivated For Each itm In Col ActiveSheet.Range("A2:Z2").Select Selection.AutoFilter Field:=6, Criteria1:=itm Call TokenNotActivatedProcess Next ActiveSheet.AutoFilter.ShowAllData End Sub 

我想要做的第三件事是在应用第二个filter后，为每个显示的结果创build一个保存在C：\ Working \中的新电子表格 。 看到一旦应用了第二个filter，电子表格以某种方式“重置”并允许新的新过滤过程（参见上面的代码）。 我一直在玩，以确保我得到正确的数据拉。 通过打印到立即窗口，这是完全正确的。 这样做的代码如下：

 ' Run the process to get the workbook saved 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 End Function 

我现在的问题是 – 如何从第3行到最后一行（在应用两个filter之后）select列A，B，C，D，E，Z，然后将其保存到外部Excel电子表格中，每次迭代过滤处理？ 我只对即时窗口中产生值的输出感兴趣（即有可见细胞的地方）。 理想情况下，我希望以下列格式提供：

 TokenNotActivated - Sarah - 110514.xlsx TokenNotActivated - John - 110514.xlsx TokenNotActivated - Jack - 110514.xlsx 

Answer 1

让我们稍微修改一下你的函数，然后返回一个值：

 Function TokenNotActivatedProcess() As Boolean Dim r As Range, n As Long, itm, FirstRow As Long, ret as Boolean 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 ret = True End If TokenNotActivatedProcess = ret End Function 

然后，你可以改变你的For each itm in Col循环For each itm in Col 。 不要调用这个函数，只要把它作为布尔逻辑的一部分来评估，因为它返回一个布尔值，你可以这样做。

 Dim ws As Worksheet Set ws = ActiveSheet For Each itm In Col ws.Range("A2:Z2").AutoFilter Field:=6, Criteria1:=itm If TokenNotActivatedProcess Then 'Dim wbNew as Workbook 'Set wbNew = Workbooks.Add ' '### Add code here which will create a new workbook ' and copy the data to the new workbook. ' This would probably be another subroutine or function. ' 'wbNew.SaveAs "C:\new file.xlsx" 'wbNew.Close End If Next 

这将最终解决它，但是您依赖于Activate和Selection方法，这在您使用多个工作簿时变得非常有问题，如下所述：

如何避免在Excel VBAmacros中使用select

我修改了上面的循环来避免这个问题，但是可能还有其他需要修复的地方。

如果您无法修改代码以避免使用激活/select方法，或者在添加新工作簿以复制数据时遇到问题，请使用当前代码更新您的问题。 这样做不应该很困难。