如何从行中search，查找和select数据并复制到新工作表

我需要build立一个macros来查找表1中所需要的行，这个行是由列A中的值预先确定的，然后将特定列（在这个例子中是D:F ）的同一行的值复制到预定位置表2

不幸的是，我不能让macros总是指向相同的单元格，因为数据不会始终在1A上开始，它可能在第3行或第10行或任何地方开始。 列应该每次都在同一个地方，但是我一定会需要macros来在A列中search所需的内容。

另外，我不想复制整个行，因为表1中的列中有更多的数据与表2中我需要的完全无关。

下面是我需要更好解释的一个例子：

表1（原始数据）

  | A | B | C | D | E | F | G | --+-------+-------+-------+-------+-------+-------+-------+ 1 | Title | M2011 | M2012 | M2013 | M2014 | M2015 | TTM | 2 | 1A | 1B | 1C | 1D | 1E | 1F | 1G | 3 | 2A | 2B | 2C | 2D | 2E | 2F | 2G | 4 | 3A | 3B | 3C | 3D | 3E | 3F | 3G | 5 | 4A | 4B | 4C | 4D | 4E | 4F | 4G | 

第2页（预期结果）

  | A | B | C | D | --+-------+-------+-------+-------+ 1 | Title | M2013 | M2014 | M2015 | 2 | 2A | 2D | 2E | 2F | 3 | 4A | 4D | 4E | 4F | 4 | 3A | 3D | 3E | 3F | 

Answer 1

这是一段代码，可以帮助你

 Sub SetGrade() Dim srcSheet As Worksheet Dim trgtSheet As Worksheet Dim foundVal As Object Dim i Set srcSheet = ThisWorkbook.Sheets(1) Set trgtSheet = Workbooks("book2").Sheets(1) For i = 1 To trgtSheet.Cells(trgtSheet.Rows.Count, "A").End(xlUp).Row 'iterate through column A in target sheet Set foundVal = srcSheet.Columns(1).Find(srcSheet.Range("a" & i).Value) 'take value from column a target sheet then look for it in column A sourcesheet srcSheet.Range(foundVal.Offset(0, 3), foundVal.Offset(0, 5)).Copy Destination:=trgtSheet.Range("B" & i) ' take cells columns D:F from found row and paste them into range starting at column B and row from which search criteria was taken Next i End Sub 

您需要根据您的情况调整工作簿名称等

Answer 2

我无法弄清楚如何使build议的公式search我所需要的，所以我刚刚结束了使用这个，然后删除它拉的额外的列。 不是最有魅力或最有效的方式，而是完成了工作

  Sub DesperateTimes() Dim Cell As Range For i = 25 To 100 Sheets("sheet1").Select If Cells(i, "A").Value = "Title" Then Rows(i).Select Selection.Copy Sheets("sheet2").Select Range("A1").Select ActiveSheet.Paste End If Sheets("sheet1").Select If Cells(i, "A").Value = "2A" Then Rows(i).Select Selection.Copy Sheets("sheet2").Select Range("A2").Select ActiveSheet.Paste End If Sheets("sheet1").Select If Cells(i, "A").Value = "4A" Then Rows(i).Select Selection.Copy Sheets("sheet2").Select Range("A3").Select ActiveSheet.Paste End If Sheets("sheet1").Select If Cells(i, "A").Value = "3A" Then Rows(i).Select Selection.Copy Sheets("sheet2").Select Range("A4").Select ActiveSheet.Paste End If Sheets("sheet2").Select Columns("E:EZ").Select Selection.ClearContents Next i End Sub