我正在尝试根据过滤条件将过滤后的数据集粘贴到不同的工作表（已创建）中。每个目标表在表中都有适当的标题信息，因此我只将过滤后的数据集粘贴到这些表中。我面临的问题是，每当我从存储的范围变量粘贴已过滤的数据集时，都会粘贴所有内容（已过滤的数据和未过滤的数据）。由于我的目标表中有表，为避免重复数据或不需要的数据，我先清除表，然后粘贴过滤后的数据。但是每次粘贴数据时，它都会转储所有数据，而不仅仅是转储的数据集。知道为什么会这样吗？
我尝试使用其他方法进行过滤，但是无论我使用什么过滤标准，excel始终使用原始工作表中的所有数据填充目标表。
Sub Formulae()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Dim StartTime As Double
Dim MinutesElapsed As String
Dim wb As Workbook
Dim sh_raw As Worksheet
Dim sh_cart As Worksheet
Dim myarr As Variant
Dim r1 As Range
Dim r2 As Range
Dim Rng As Range
Dim xWs As Worksheet
'Remember time when macro starts
StartTime = Timer
Set wb = ThisWorkbook
Set sh_cart = wb.Sheets("Cart Information")
''Checking if the Raw_Data sheet exists or not. If not exists, then MACRO aborts and prompts the user to run the import macro first.
For Each sh In Worksheets
If sh.Name Like "Raw*" Then flg = True: Exit For
Next
If flg = True Then
GoTo Start:
Else
MsgBox "No Raw Data Sheet exists!!! Please run the 'Import' Macro First."
GoTo ResetSettings:
End If
Start:
Set sh_raw = wb.Sheets("Raw_Data") 'My source data resides in this raw datasheet
With sh_raw
.Range("G1").Value = "Section"
.Range("G2").Formula = "=VLOOKUP([@[IP_Address]],Cart_Information,6,0)"
'.Range("E2", Range("E2").End(xlDown)).NumberFormat = "m/d/yyyy"
.Cells.Columns.AutoFit
End With
'sh_raw.Cells.AutoFit
'Here I will filter the raw data set based on the section list in another sheet
sh_cart.Activate
Set Rng = Range("H1", Range("H1").End(xlDown)) 'Setting the criteria list inside a range
myarr = Application.WorksheetFunction.Transpose(Rng) 'Storing the range in an array by transposing the list
'Now I"ll filter the base table according to my filter list
For Each item In myarr
sh_raw.Activate
'Debug.Print item
'''I wanna copy only the visible range below the header from the filtered raw data set
sh_raw.ListObjects("ELMS").Range.AutoFilter Field:=7, Criteria1:=item
'Set r2 = sh_raw.ListObjects("ELMS").AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(2)(1, 1)
'Set r2 = Range(r2, r2.End(xlToRight))
'Set r2 = Range(r2, r2.End(xlDown))
Set r1 = sh_raw.ListObjects("ELMS").AutoFilter.Range
Set r2 = Intersect(r1.Offset(1, 0), r1) 'storing the filtered range without the header in r2 range variable
'''Looping through each template sheets which are named after the filter criteria list
For Each xWs In Application.ActiveWorkbook.Worksheets
If xWs.Name = item Then
xWs.Activate
With xWs
'.Range("A1:Q1").AutoFilter
.Range("A2:Q2", Range("A2:Q2").End(xlDown)).ClearContents 'Clearing the table first in case there is data from previous run
'.Range("A2").Select
'.Range("A2:Q2", Range("A2:Q2").End(xlDown)).Delete
End With
r2.Copy Destination:=ActiveSheet.Range("A2") 'Now pasting the stored data in the template table
''Also I'm pasting all the required formulae in the sheet for making a pivot table & chart based on the filtered dataset
With xWs
.Range("E2", Range("E2").End(xlDown)).NumberFormat = "m/d/yyyy"
.Range("H2").Formula = "=INT(E2)" 'since this is a table, the formula gets autofilled throughout the cells
'.Range("H2", "H" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("I2").Formula = "=IF(ISNUMBER(SEARCH(""Hour"",B2)),MAX(0,IF(AND(D3=D2,B3=B2),C3-C2,0),),"""")"
'.Range("I2", "I" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("J2").Formula = "=IF(ISNUMBER(SEARCH(""Hour"",B2)),MIN(IF(HOUR($E2)=20,4,IF(HOUR($E2)=0,8,IF(HOUR($E2)=4,12,IF(HOUR($E2)=8,16,0)))),MAX(0,IF(AND(D2=D1,B2=B1),C2-C1,0),)),"""")"
'.Range("J2", "J" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
'.Range("K2").Formula = "=INT(E2)" 'Dummy formula for now
'.Range("K2", "K" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("L2").FormulaArray = "=INDEX([Field_Value],MATCH(1,(""Test_Location""=[Field_Name])*([@[IP_Address]]=[IP_Address])*([@[Poll_Date]]=[Poll_Date]),0))"
'.Range("L2", "L" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("K2").FormulaArray = "=IF([@Channel]=0,"""",INDEX(Cycler_Channel[[1]:[8]],MATCH([@Cycler],Cycler_Channel[Cycler],0),[@Channel]))" ''Actual formula is used
'.Range("K2", "K" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("K2", Range("K2").End(xlDown)).NumberFormat = 0
.Range("M2").FormulaArray = "=INDEX([Field_Value],MATCH(1,(""TC_IPaddress""=[Field_Name])*([@[IP_Address]]=[IP_Address])*([@[Poll_Date]]=[Poll_Date])*([@Channel]=[Channel]),0))"
'.Range("M2", "M" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("N2").FormulaArray = "=INDEX([Field_Value],MATCH(1,(""UUTID""=[Field_Name])*([@[IP_Address]]=[IP_Address])*([@[Poll_Date]]=[Poll_Date])*([@Channel]=[Channel]),0))"
'.Range("N2", "N" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Range("O2", Range("O2").End(xlDown)).Value = "TBD"
.Range("P2", Range("P2").End(xlDown)).Value = "TBD"
.Range("Q2").Formula = "=VLOOKUP(D2,Cart_Information,5,FALSE)"
'.Range("Q2", "Q" & Cells(Rows.count, 1).End(xlUp).Row).FillDown 'filling the entire column with the formula
.Cells.Columns.AutoFit
End With
End If
Next
Next item
'Refreshing the pivot table once pivot tables have been updated with latest data
Dim pt As PivotTable
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
For Each pt In WS.PivotTables
pt.RefreshTable
Next pt
Next WS
'Determine how many seconds code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes.", vbInformation ''Displaying the information for macro execution time
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End Sub
我希望我的代码仅将过滤后的数据粘贴到目标表中，但是即使我将过滤后的数据集专门存储在范围变量中，它也会粘贴整个原始数据集。