Excel 要在两个工作表之间复制和粘贴，搜索功能需要对粘贴的行数进行限制

正如标题所说-此代码将搜索Sheet1，第I列中的某个单词；e、 g“白色”，并将所有匹配项粘贴到第2页的设定行中。白色代表武术白色腰带，将所有被列为白色腰带的学生姓名粘贴到第2页的设定行号/页码中，然而，我只能在一页上放30个名字，有些月份有30多个白带，所以我需要它将前30个名字粘贴到设置的行中，剩下的在下一页中，比如说，从30个白带向下5行

有数百名学生和23个不同的皮带级别，它们总是改变表1上的行号，因此固定方法不起作用。请帮忙

Sub ADULTClearAndPaste()

Dim lr As Long, lr2 As Long, r As Long
Set Sh1 = ThisWorkbook.Worksheets("ADULT members to cut & past")
Set Sh2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet")

Sh1.Select

lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row
w = 7
For r = 2 To lr
If Range("I" & r).Value = "White" Then
    Sh2.Cells(w, 5).Value = Sh1.Cells(r, 2).Value
    Sh2.Cells(w, 6).Value = Sh1.Cells(r, 3).Value
    w = w + 1
End If

Next r

py = 79

For r = 2 To lr
If Range("I" & r).Value = "Pro Yellow" Then
    Sh2.Cells(py, 5).Value = Sh1.Cells(r, 2).Value
    Sh2.Cells(py, 6).Value = Sh1.Cells(r, 3).Value
    py = py + 1
End If

Next r
Sh2.Select

End Sub

---

你可能会遇到一些问题。您将w和py定义为整数，但您说过每个类别中可能有大量的人，我假设这些数字会发生变化，因此您可能会在指定从哪一行开始时出现问题

这将允许您将23种皮带颜色作为一个数组输入（将皮带（2）更改为皮带（23）并填充颜色），然后它将根据第一页上每种颜色的数量格式化第二张纸

我假设你在前六行的第二张纸上有一个标题。您可能需要更新页眉变量以准确引用该范围，因为这将插入分页符，然后根据需要重复复制该页眉：

Sub ADULTClearAndPaste()
Dim Belts(2) As String
Belts(1) = "White"
Belts(2) = "Pro Yellow"

Dim NewRow As Long
Dim RowCounter As Long
Dim Item As Range
Dim Header As Range
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet

Set Sht1 = ThisWorkbook.Worksheets("ADULT members to cut & past")
Set Sht2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet")
'Specify Header Range
Set Header = Sht2.Range("A1:F6")

NewRow = 7
For i = 1 To UBound(Belts)
    'This creates a new header/page for the next belt color
    If NewRow <> 7 Then
        Sht2.Rows(NewRow).PageBreak = xlPageBreakManual
        Sht2.Range(Sht2.Cells((NewRow), 1), Sht2.Cells((NewRow + 5), 6)).Value = Header.Value
        NewRow = NewRow + 6
    End If

    'This will reference which color is being processed,
    'I put it in there for reference but I figured you would update it
    Sht2.Range("A" & NewRow).Value = Belts(i)
    RowCounter = 0

    For Each Item In Sht1.Range("I1:I" & Sht1.UsedRange.Rows.Count)

        If Item.Value = Belts(i) Then
            Sht2.Cells(NewRow, 5).Value = Item.Offset(0, 1).Value
            Sht2.Cells(NewRow, 6).Value = Item.Offset(0, 2).Value
            NewRow = NewRow + 1
            RowCounter = RowCounter + 1
            If RowCounter = 30 Then
                'When you hit 30 lines the counter resets and a new header is added
                Sht2.Rows(NewRow).PageBreak = xlPageBreakManual
                Sht2.Range(Sht2.Cells((NewRow), 1), Sht2.Cells((NewRow + 5), 6)).Value = Header.Value
                NewRow = NewRow + 6
                RowCounter = 0
            End If
        End If
    Next Item
Next i
Sht2.Select

End Sub

Sub-ADULTClearAndPaste（）
将皮带（2）调细为细绳
皮带（1）=“白色”
皮带（2）=“专业黄色”
昏暗的纽罗
暗排计数器与长排计数器相同
将项目设置为范围
将标题变暗为范围
Dim Sht1作为工作表
将Sht2变暗为工作表
Set Sht1=此工作簿。工作表（“要剪切的成年成员（&past））
Set Sht2=此工作簿。工作表（“成人签到表”）
'指定标题范围
设置标题=Sht2.范围（“A1:F6”）
纽罗=7
对于i=1至uBond（皮带）
'这将为下一个皮带颜色创建新的标题/页面
如果是第7行，那么
Sht2.Rows（NewRow）.PageBreak=xlPageBreakManual
Sht2.Range（Sht2.Cells（（新行），1），Sht2.Cells（（新行+5），6））.Value=Header.Value
新行=新行+6
如果结束
'这将引用正在处理的颜色，
我把它放在那里作为参考，但我想你会更新它
Sht2.范围（“A”和NewRow）.值=皮带（i）
行计数器=0
对于Sht1.Range中的每个项目（“I1:I”&Sht1.UsedRange.Rows.Count）
如果项目价值=皮带（i），则
Sht2.Cells（NewRow，5）.Value=Item.Offset（0，1）.Value
Sht2.Cells（NewRow，6）.Value=Item.Offset（0，2）.Value
NewRow=NewRow+1
行计数器=行计数器+1
如果RowCounter=30，则
'当您点击30行时，计数器复位，并添加一个新的标题
Sht2.Rows（NewRow）.PageBreak=xlPageBreakManual
Sht2.Range（Sht2.Cells（（新行），1），Sht2.Cells（（新行+5），6））.Value=Header.Value
新行=新行+6
行计数器=0
如果结束
如果结束
下一项
接下来我
Sht2.选择
端接头

您好，感谢您的努力。我认为有些事情需要澄清。在我的原始代码中，W和PY是我希望粘贴名称的特定位置，这些值永远不会更改。Sh2需要保持原样，因为上面有很多格式，所以人们可以选择哪天来训练。只有Sh1上的名称会四处移动并更改行号。你能让它做一些事情，比如在sh1上找到第一条白色带子，然后从那里倒数吗。再次感谢你的帮助。