如果条件为 ，则将 Excel 中的行复制到工作表。

Question

我正在尝试根据 D 列中的数据将工作表“全部”的整行复制到另一张工作表。D 列（家庭作业/高级/初学者）中有多个值，并且需要复制这些行才能拥有的工作表相应的名称。 （作业到作业表。）

“全部”表中的数据将被添加到其中，并且需要复制新数据，而不是复制已有的数据。

Answer 1

这不是什么大问题。最好的办法是让事情保持简单，并在“所有”发生变化时复制所有内容。我在“全部”工作表上有一个“重新分配”按钮，并让事件调用 scatterRows()

你没有说你的源工作表是什么样子，所以我为工作表“全部”做了一些准备：

9   0.181626294 carrot  beginner    Irene
5   0.221180184 beans   advanced    Eva
8   0.221813735 turnip  advanced    Harry
10  0.314800867 lettuce homework    John
4   0.360163255 peas    homework    Doug
11  0.379956592 pepper  advanced    Karen
3   0.44415906  tomato  beginner    Charlie
6   0.647446239 corn    beginner    Frank
2   0.655706735 potato  advanced    Bob
7   0.666002258 lentils homework    George
1   0.768524361 squash  homework    Alice

代码相当灵活;它会找到整个源块，因此只要“D”列包含工作表键并且数据从 A1 开始（无标题），有多少列并不重要。如果您有标题，请将所有 A1 引用更改为 A2。

其他工作表（“作业”等）必须已创建。 --并且您需要 Microsoft 脚本运行时的参考集。

代码中唯一“有趣”的部分是计算目标范围的字符串 (putString)。

Option Explicit

'' Copy rows from the "all" sheet to other sheets
'' keying the sheetname from column D.
'' **** Needs Tools|References|Microsoft Scripting Runtime
'' Changes:
''      [1] fixed the putString calculation.
''      [2] Added logic to clear the target sheets.

Sub scatterRows()

    Dim srcRange As Range
    Dim srcRow As Range
    Dim srcCols As Integer
    Dim srcCat As String
    Dim putRow As Integer
    Dim putString As String
    Dim s                      ''*New [2]

    '' Current row for each category
    Dim cats As Dictionary
    Set cats = New Dictionary
    cats.Add "homework", 0
    cats.Add "beginner", 0
    cats.Add "advanced", 0

    '' Clear the category sheets  *New [2]
    For Each s In cats.Keys
        Range(s & "!A1").CurrentRegion.Delete
    Next s

    '' Find the source range
    Set srcRange = [all!a1].CurrentRegion
    srcCols = srcRange.Columns.Count

    '' Move rows from source Loop
    For Each srcRow In srcRange.Rows

        '' get the category
        srcCat = srcRow.Cells(4).Value

        '' get the target sheet row and increment it
        putRow = cats(srcCat) + 1
        cats(srcCat) = putRow

        '' format the target range string     *Fixed [1]
        '' e.g. "homework!A3:E3"
        putString = srcCat & "!" & _
            [a1].Offset(putRow - 1, 0).Address & _
            ":" & [a1].Offset(putRow - 1, srcCols - 1).Address

        '' copy from sheet all to target sheet
        Range(putString).Value = srcRow.Value
    Next srcRow
End Sub