Vba 根据搜索条件复制其他工作表中的数据，并遵循匹配规则或过程

我有一张包含（A10:I37）数据的表。我想根据A列中的特定单词对数据进行排序。在我的情况下，它是是，然后我想将单词是前面的数据复制到其他一些表2，但我想将数据分配到它们的特定单词前面，如Info 1 Info 2 Info 3我希望根据搜索条件（如“是”）将我的数据复制到sheet2，并在第10行中指定的相应单词下。我试图写一些东西，但仍然无法达到我想要的内容。任何指导都将不胜感激

让我们简单一点

         **Sheet1**                              **Sheet 2**
 10 Col A    Info 1   Info 2   Info 3   Info 4                                      

    Yes       Car      Bus     Plane    Truck    Info 1   Car   1  Bat  tall      

    No        1         2       3         4      Info 2   Bus   2  Pen   5
    Yes      bat       pen      copy     ball    Info 3   Plane 3  copy  6   
    No       tall       5       6         7      Info 4   truck 4  ball  7

代码

       Dim i As Integer
       Dim Percent As Variant
       Dim Search As String
       Search = InputBox("Enter your search word here")
       If Search = "" Then Exit Sub
       For i = 1 To Range("A65536").Cells.End(xlUp).Row
           If Cells(i, 1) = Search Then GoTo Other
         Next i
               MsgBox "Nicht in Spalte enthalten"
          Exit Sub
       Other:
         For i = 1 To Range("A65536").Cells.End(xlUp).Row
          If Cells(i, 1) = Search Then
            Cells(i, 2).Select
             'Range("B17").Select
            Selection.Copy
             'Range("K18").Select
            Sheets("Sheet1").Cells(i, 2).Copy Destination:=Sheets("Sheet2").Range("C16") 


          End If
          Next i

代码2 我从某处发现的这个代码试图修改它作为我的需求，但直到无法成型它。< /P>

Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")

j = 1     ' Start copying to row 1 in target sheet
For Each c In Source.Range("A1:A1000")   ' Do 1000 rows
    If c = "yes" Then
     Source.Rows(c.Row).Copy Target.Rows(j)


       j = j + 1
    End If
Next c

此代码只搜索Yes单词并将整行复制到工作表2中，但我希望根据匹配条件将数据复制到下一个工作表中

如有任何帮助，我将不胜感激，因为我已经尝试过，但仍然无法找到方法。谢谢。

---

< p>我会修改你发现的第二个宏，而不是一个范围，并在目标表中转置复制范围：

 Dim i As Integer
 Dim j As Integer
 Dim Source As Worksheet
 Dim Target As Worksheet

 ' Change worksheet designations as needed
 Set Source = ActiveWorkbook.Worksheets("Sheet1")
 Set Target = ActiveWorkbook.Worksheets("Sheet2")

 Rows(1).Select.Copy 
 Target.Cells(1,1).PasteSpecial Transpose:=True

 j = 2     ' Start copying to column 2 in target sheet
 i = 1     ' Start Searching from the first row in source sheet

 While Source.Cells(i,1) <> ""

    If Source.Cells(i,1) = "yes" Then
       Rows(i).Select.Copy 
       Target.Cells(1,j).PasteSpecial Transpose:=True
       j = j + 1
    End If

    i = i + 1
 Wend

Dim i作为整数
作为整数的Dim j
将源设置为工作表
将目标变暗为工作表
'根据需要更改工作表名称
Set Source=ActiveWorkbook.Worksheets（“Sheet1”）
设置目标=活动工作簿。工作表（“Sheet2”）
行（1）。选择。复制
Target.Cells（1,1）.PasteSpecial转置：=True
j=2'开始复制到目标工作表中的第2列
i=1'从源工作表的第一行开始搜索
而Source.Cells（i，1）“”
如果Source.Cells（i，1）=“是”，则
行（i）.选择.Copy
Target.Cells（1，j）.PasteSpecial转置：=True
j=j+1
如果结束
i=i+1
温德

在您的示例中，

Info 1

和

ball

之间的关系是什么？Info 4包含Truck，4，ball，7。信息1包含汽车、1、球拍、高度等。信息表示信息，信息1表示它包含与之相关的数据，如汽车、1、球拍、高度。信息1和球之间没有关系。信息4和球之间有关系。对不起-我的意思是-信息4和球之间的关系是什么（不是信息1）。因为

ball

位于

Yes

行。在您的示例中，它位于

工作表

上的

Info 4

行。请查看上面的图片。这将使它变得容易。信息4有数据，球在信息4下。是仅为搜索条件。我也可以更改yes.Thx Masoud的位置，但此代码只复制包含yes的行。我想要的是将包含“是”的行的数据转置复制到其各自位置的其他工作表中。@MuhammadNauman请将此作为所需输出添加到yoir问题中，并通过提供图片来澄清。我会在有时间的时候修改我的答案。@MuhammadNauman我引用这句话：“如果答案旁边的复选标记有用的话，别忘了给你的服务员小费。”这会让每个人都能找到一个已经问过的问题的答案。很抱歉延迟回复。因为我没空。非常感谢你的帮助和时间。我真的很感激。这对我来说非常有效，并且一直在为奥特斯提供帮助。再次为延误道歉。