在基于search标准的其他工作表中复制数据，并遵循匹配规则或过程

我有包含来自（A10：I37）的数据的工作表。 我想根据列A中的特定单词对数据进行sorting。在我的情况下是“是” ，然后我想将单词“前面的数据”复制到某个其他表单2中，但是我希望将数据分配在其前面如Info 1 Info 2 Info 3. 我希望我的数据被复制到sheet2基于search标准，如是和第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我从某处find的这个代码试图修改它作为我的需求，但直到无法模塑它。

 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 

此代码只search是单词，并将整个行复制到工作表2，但我想根据匹配条件将数据复制到下一个工作表中。

任何帮助将不胜感激，因为我已经尝试，但仍然无法find一个方法。 谢谢。

Answer 1

我将修改您发现考虑单元格而不是范围的第二个macros，并将复制的范围转置到目标工作表中：

  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