Excel VBA自动过滤，复制并粘贴到命名表

Question

我已经编写了一些代码来根据另一张表中的 filter_val 集自动过滤 filter_range 中的值。我想要的 |Result 是一个以 cust_DMA 中的每个 filter_val 命名的选项卡，并针对该值过滤了值。

在遍历“filter_val”列表时，我对这部分代码不满意

' filter_val = .Cells(i, 1).Value
 filter_range.AutoFilter Field:=8, Criteria1:=filter_val ''''autofilter field should be 8 as h is column 8
Billed_sheet.Range("a:v").copy
cust_DMA.Sheets.Add.Name = filter_val
ActiveSheet.Paste ''sometimes breaks here;

虽然它产生了我想要的结果，但我不喜欢使用 Activesheet.Paste 并且偶尔这行代码会失败。

谁能为此推荐一个更好的解决方案？我尝试根据过滤后的单元格设置范围，但是当我使用此范围向 Cust_DMA 表添加值时，它们会被复制整个范围，而不仅仅是过滤后的值。

代码如下，

干杯

Sub filter_DMA_debugged_23_03_15(filter_val As String, filter_range As Range, Lrow As Long, LBox As Object, List_row As Long, DMA_sht As Worksheet, DMA_wb As Workbook, cust_DMA As Workbook, FPath As String, FName As String, list_val As String, i As Integer) 'working
'''works in stepthrough/runtime but the activesheet paste is a bit volatile - find a solution
Application.ScreenUpdating = False

    Set DMA_wb = Workbooks("DMA_metered_tool_v11_SICTEST.xlsm")
    Set DMA_sht = DMA_wb.Worksheets("DMA list")
    FPath = DMA_sht.Range("c8").Text
    FName = ("DMA_customers_SICTEST.xlsx")
    Workbooks.Add.SaveAs FileName:=FPath & "\" & FName ''''
    Set cust_DMA = Workbooks("DMA_customers_SICTEST.xlsx")
    Set Billed_sheet = Workbooks("Billed_customers_SICTEST.xls").Sheets("Non Household Metered Users")

            With Billed_sheet

                .AutoFilterMode = False ' clear any existing filter to get accurate row count
                Lrow = .Range("a" & .Rows.count).End(xlUp).row
                Set filter_range = .Range("a1:v" & Lrow) '''try changing to a:v to avoid missing anything

            End With

                With DMA_sht

                    List_row = .Range("a" & .Rows.count).End(xlUp).row

                        For i = 2 To List_row '- 1 removed '-1 as it was missing the last value, starting at 2 already accounts for list_row having more items in it than needed.

                            filter_val = .Cells(i, 1).Value
                            filter_range.AutoFilter Field:=8, Criteria1:=filter_val ''''autofilter field should be 8 as h is column 8
                            Billed_sheet.Range("a:v").copy
                            cust_DMA.Sheets.Add.Name = filter_val
                            ActiveSheet.Paste ''sometimes breaks here

                        Next i

                End With

Application.ScreenUpdating = True

End Sub

Answer 1

我以前做过类似的事情，请测试以下内容，看看它是否适合您的需求。

' filter_val = .Cells(i, 1).Value
filter_range.AutoFilter Field:=8, Criteria1:=filter_val 
cust_DMA.Sheets.Add.Name = filter_val
'ActiveSheet.Paste ''sometimes breaks here;
With ActiveSheet.AutoFilter.Range. 
    .Copy  Sheets(filter_val).Range("A1") 'may need to change target
    .Clear 
End With 

Answer 2

感谢我被定向到here 的信息，我在下面有一个工作版本，代码中有 cmets。如果有人想提出任何建议，我相信它可以变得更加优雅。感谢您的意见。

Dim CopyFrom As Range
Application.ScreenUpdating = False
Set DMA_wb = Workbooks("DMA_metered_tool_v12_SICTEST.xlsm")
Set DMA_sht = DMA_wb.Worksheets("DMA list")
FPath = DMA_sht.Range("c8").Text
FName = ("DMA_customers_SICTEST.xlsx")
Workbooks.Add.SaveAs FileName:=FPath & "\" & FName
Set cust_DMA = Workbooks("DMA_customers_SICTEST.xlsx")
Set Billed_sheet = Workbooks("Billed_customers_SICTEST.xls").Sheets("Non Household Metered Users")

        With Billed_sheet

            .AutoFilterMode = False ' clear any existing filter to get accurate row count
            Lrow = .Range("a" & .Rows.count).End(xlUp).row
            Set filter_range = .Range("a1:v" & Lrow) '''try changing to a:v to avoid missing anything

        End With

            With DMA_sht

                List_row = .Range("a" & .Rows.count).End(xlUp).row

                    For i = 2 To List_row '- c1 removed '-1 as it was missing the last value, starting at 2 already accounts for list_row having more items in it than needed.

                        filter_val = .Cells(i, 1).Value
                        filter_range.AutoFilter Field:=8, Criteria1:=filter_val ''''autofilter field should be 8 as h is column 8
                        cust_DMA.Sheets.Add.Name = filter_val
                        Set CopyFrom = Billed_sheet.Range("a1:v" & Lrow).SpecialCells(xlCellTypeVisible) ' set range as filtered values only
                        CopyFrom.copy 'copy filtered values
                        .AutoFilterMode = False 'remove filters
                        cust_DMA.Sheets(filter_val).Range("a1").PasteSpecial xlPasteValues
                    Next i

            Application.ScreenUpdating = True
            End With