Excel 如何将数据复制并粘贴到使用for loop在VBA中创建的工作表中？

我正在尝试复制和粘贴数据，并将它们分配到不同的工作表中。例如，如果F列为martin 1，则包含martin 1的整行将粘贴到工作表（“Index1”）。Charlie 1也是这样，它将被粘贴到工作表（“Index2”）。但是，我在这里遇到了一个对象定义的错误，如下面的代码所示。有什么办法解决吗

Sub SaveRangewithConsecutiveDuplicateValuestoNewSheet()
'Define all variables
Dim wb As Workbook, ws As Worksheet, sCel As Range, rwNbr As Long

Set wb = ThisWorkbook 'Set workbook variable
Set ws = wb.Worksheets("Sheet1") 'set worksheet variable using workbook variable

Set sCel = ws.Cells(1, 6) 'Set the first start cell variable to test for duplicate values
            Dim i As Integer
            Dim site_i As Worksheet
            For i = 1 To 3
               Set site_i = Sheets.Add(after:=Sheets(Worksheets.count))
               site_i.Name = "Index" & CStr(i)
                Next i

    Application.DisplayAlerts = False
        For rwNbr = 2 To ws.Cells(ws.Rows.count, 6).End(xlUp).Offset(1).Row Step 1 'Loop

            If ws.Cells(rwNbr, 6).Value = "Martin1" Then
 ws.Range(sCel, ws.Cells(rwNbr, 6)).EntireRow.Copy Destination:=Sheets("Index1").Range("A1")
 ElseIf ws.Cells(rwNbr, 6).Value = "Charlie1" Then
    ws.Range(sCel, ws.Cells(rwNbr - ws.UsedRange.Rows.count, 6)).EntireRow.CopyDestination:=Sheets("Index2").Range("A1") '<----application defined or object defined error here

            End If

        Next rwNbr
    Application.DisplayAlerts = True
End Sub

子存储范围和连续的重复值stonewsheet（）
'定义所有变量
将wb作为工作簿、ws作为工作表、sCel作为范围、rwNbr作为长
Set wb=ThisWorkbook的Set工作簿变量
Set ws=wb.Worksheets（“Sheet1”）使用工作簿变量设置工作表变量
Set sCel=ws.Cells（1,6）'设置第一个开始单元格变量以测试重复值
作为整数的Dim i
Dim site_i As工作表
对于i=1到3
设置site_i=Sheets.Add（之后：=Sheets（Worksheets.count））
站点i.Name=“索引”和CStr（i）
接下来我
Application.DisplayAlerts=False
对于rwNbr=2到ws.Cells（ws.Rows.count，6）。结束（xlUp）。偏移量（1）。行步骤1'循环
如果ws.Cells（rwNbr，6）.Value=“Martin1”，则
ws.Range（sCel，ws.Cells（rwNbr，6））.EntireRow.Copy目标：=工作表（“Index1”）.Range（“A1”）
ElseIf ws.Cells（rwNbr，6）.Value=“Charlie1”然后
ws.Range（sCel，ws.Cells（rwNbr-ws.UsedRange.Rows.count，6））.EntireRow.CopyDestination:=Sheets（“Index2”）.Range（“A1”）”如果您的原始数据没有标题行，那么我将使用循环收集目标单元格并相应地复制它们。

您需要将
Arr
中的3个目标值更新为
Charlie1
，
Martin1
等

宏步骤

在
Arr
循环浏览
表1中的每一行

将目标行添加到联合体（单元格集合）
将
接头
复制到目标工作表，其中目标
工作表索引#=Arr位置+1


然而，在我这一方，测试和工作正如预期的那样

如果您有标题，那么使用复制/粘贴会容易得多。如果在同一本书上运行同一个宏两次，这将由于许多原因而中断，例如重复的工作表名称、中断
工作表索引#=Arr Position+1
，等等。
@urdboy在ElseIf ws.Cells（rwNbr，6）后面的行。Value=“Charlie1”然后您要复制什么？一排？还是每行都有
字符1
？只需为每个值筛选F列，并将可见单元格复制到相应的工作表中，就可以省去一些麻烦。尽管如此，这里似乎没有标题行，这是有问题的。另一个问题，这个示例是否推断到您的实际集合？现在您只需要查找2个值，如果您要查找5个值呢？每次都需要修改代码。如果过分简化了示例数据，您可能需要重新考虑使用的逻辑。犹豫不决地发布答案，因为我认为这个问题的答案不是你最终需要的。@Urderboy与Charlie1的每一行。好的，这里的要点不是手动从excelsheet复制，因为我试图创建一个程序，可以自动检测martin1和Charlie 1，并提取它们具有相同名称的整行，将它们粘贴到不同的位置worksheets@urdearboy我最终要找3个名字
Sub Filt()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim cs As Worksheet

Dim Arr: Arr = Array("Value1", "Value2", "Value3")

Dim x As Long, Target As Long, i As Long
Dim CopyMe As Range

'Create 3 Sheets, move them to the end, rename
For x = 1 To 3
    Set cs = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
    cs.Name = "Index" & x
Next x

lr = ws.Range("F" & ws.Rows.Count).End(xlUp).Row

'Loop through each name in array
For Target = LBound(Arr) To UBound(Arr)
   'Loop through each row
    For i = 1 To lr

        'Create Union of target rows
        If ws.Range("F" & i) = Arr(Target) Then
            If Not CopyMe Is Nothing Then
                Set CopyMe = Union(CopyMe, ws.Range("F" & i))
            Else
                Set CopyMe = ws.Range("F" & i)
            End If
        End If
    Next i

    'Copy the Union to Target Sheet 
    If Not CopyMe Is Nothing Then
        CopyMe.EntireRow.Copy Destination:=ThisWorkbook.Sheets("Index" & Target + 1).Range("A1")
        Set CopyMe = Nothing
    End If

Next Target

End Sub