从dynamic范围dynamic地拉行数据
我有一个电子表格，其中包含一个关于食物成分的原始数据大表。 那么这些数据必须按新的成分进行sorting，清除旧的数据，并填入新的数据。
电子表格最初设置为使用户必须手动点击“清除数据”button，然后在每个单独的选项卡上单击“拉出新数据”button。 这个工作簿有几十个标签，并且随着新的成分被添加不断增长。
我已经设置了一个macros，通过一次运行清除所有数据，但是我无法使工作表dynamic分类并将数据提取到每个单独的工作表。 我可以通过硬编码每个单独的选项卡的名字来蛮力，但是每次需要添加新的成分时，都需要更新macros。 我正在寻找尽可能dynamic，并感觉我接近。
每个配料表在“A1”中都有配料对应的物料编号，在search中用作标识符。
我需要从电子表格中得到的总体行为如下：1.）比较活动工作表A1范围内的材料编号与“原始数据”工作表上的第一个材料编号。
2.）如果活动工作表的物料编号与当前行中的物料编号相匹配，则将原始数据表中的整个行复制到活动工作表。
3.）如果这些单元格不匹配，则移动到列中的下一行并重复，直到列的末尾。
4.）激活工作簿中的下一张纸并重复该过程，直到所有的纸张都已经循环。
以下是我目前的代码：
Sub PullNewData() Dim wks As Worksheet Set i = Sheets("Raw Data") Set e = ActiveSheet Dim d Dim j d = 20 j = 2 For Each wks In ActiveWorkbook.Worksheets If wks.Name <> "Ingredient List" Then If wks.Name <> "Raw Data" Then If wks.Name <> "Instructions" Then wks.Activate For Each Cell In i.Range("B2:B10000") If i.Range("B" & j) = e.Range("A1") Then d = d + 1 e.Rows(d).Value = i.Rows(j).Value End If j = j + 1 Next Cell d = 20 j = 2 End If End If End If Next wks End Sub 这个代码适用于任何纸张被激活（拉取正确的数据），然后在纸张的其余部分循环而不复制任何纸张的数据。 任何人都可以告诉我为什么这个代码不复制到最初没有激活的工作表？
PS接近开头的三重IF语句排除三张数据库的数据sorting。
这不依赖于ActiveSheet
Option Explicit Public Sub PullNewData2() Const RAW_COL = 2 'B column in "Raw Data" ws Const THIS_LAST_ROW = 20 'last used row on current ws Dim ws As Worksheet, wsRaw As Worksheet, urRaw As Variant, r As Long Set wsRaw = ThisWorkbook.Worksheets("Raw Data") urRaw = wsRaw.UsedRange Dim xclude As Variant, cellA1 As String, lr As Long, foundRow As Long xclude = Array("Ingredient List", "Raw Data", "Instructions") For Each ws In ThisWorkbook.Worksheets If ws.Name <> xclude(0) And ws.Name <> xclude(1) And ws.Name <> xclude(2) Then foundRow = THIS_LAST_ROW cellA1 = Trim$(ws.Range("A1").Value2) For r = 2 To UBound(urRaw) If urRaw(r, RAW_COL) = cellA1 Then foundRow = foundRow + 1 ws.Rows(foundRow).Value = wsRaw.Rows(r).Value End If Next r End If Next ws End Sub
一个更快的方法是使用AutoFilter
Option Explicit Sub PullNewData3() Const RAW_COL = 2 'B column in "Raw Data" ws Const FIRST_ROW = 21 Dim ws As Worksheet, wsRaw As Worksheet, xclude As Variant, cellA1 As String Set wsRaw = ThisWorkbook.Worksheets("Raw Data") xclude = Array("Ingredient List", "Raw Data", "Instructions") optimizeXL True For Each ws In ThisWorkbook.Worksheets If ws.Name <> xclude(0) And ws.Name <> xclude(1) And ws.Name <> xclude(2) Then cellA1 = Trim$(ws.Range("A1").Value2) With wsRaw.UsedRange If wsRaw.AutoFilterMode Then .AutoFilter 'clear filters .AutoFilter Field:=RAW_COL, Criteria1:=cellA1 .Copy ws.Cells(FIRST_ROW, 1) ws.Cells(FIRST_ROW, 1).EntireRow.Delete 'if 1st row contains Headers .AutoFilter 'clear filter End With End If Next ws optimizeXL False End Sub Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True) With Application .ScreenUpdating = Not settingsOff .Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic) .EnableEvents = Not settingsOff End With End Sub