Excel VBA autofilter, скопируйте и вставьте в указанный лист

Question

Я написал немного кода для значений автофильтра в filter_range на основе набора filter_val с другого листа. | Результат, который я хочу, представляет собой вкладку с именем после каждого filter_val в cust_DMA со значениями, отфильтрованными для этого значения.

В то время как цикл по списку «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, у меня есть рабочая версия ниже, комментарии в коде. Я уверен, что его можно было бы сделать более элегантным, если кто-то хотел бы предложить что-нибудь. Спасибо за ввод.

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