[英]Excel VBA autofilter, copy and paste to named sheet
I have written a bit of code to autofilter values in filter_range
based on the filter_val
set from another sheet. 我写了一些代码,根据另一张纸上设置的
filter_val
自动filter_range
的值。 The |Result I want is a tab named after each filter_val
in the cust_DMA
with the values filtered for this value. 我想要的结果是一个以
cust_DMA
每个filter_val
命名的选项卡,其中cust_DMA
值过滤的值。
Whilst looping through the list of 'filter_val' I am unhappy with this section of the code 在遍历“ 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;
As although it produces the results I want, I do not like using Activesheet.Paste
and occasionally this line of the code fails. 尽管它产生了我想要的结果,但我不喜欢使用
Activesheet.Paste
,有时这一行代码会失败。
Can anyone recommend a better solution for this? 有人可以为此推荐更好的解决方案吗? I have tried setting a range based on the filtered cells, but when I use this range to add values to the Cust_DMA sheet, they whole range is copied, rather than just the filtered values.
我曾尝试根据过滤后的单元格设置范围,但是当我使用此范围将值添加到Cust_DMA工作表时,将复制整个范围,而不仅仅是过滤后的值。
Code below, 下面的代码
Cheers 干杯
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
I've done something like this before, please test the following and see if it works for your needs. 我之前已经做过类似的事情,请测试以下内容,看看它是否可以满足您的需求。
' 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
Thanks to the information I was directed to here , I have a working version below, comments in the code. 多亏了我被引导到这里的信息,下面有一个工作版本,代码中有注释。 I am sure it could be made more elegant if anyone would like to suggest anything.
我敢肯定,如果有人愿意提出任何建议,它可以变得更加优雅。 Thanks for the input.
感谢您的输入。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.