这一个不太好，但可能会让你去：

Sub CreateSPSSFeed()

Dim StudentID As String '(StudentID is a unique identifier)
Dim Tool As Worksheet '(this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet '(this is the sheet I'm pulling data from)
'Dim i As Integer '(loop counter)    'You don't need to define it

Set Tool = ActiveWorkbook.Worksheets("ToolSheet") 'you'll need to use the Set command, don't ask why
Set Survey1 = ActiveWorkbook.Worksheets("Survey1Sheet")

ToolLastRow = Tool.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'so you won't need to loop through a million rows each time
Survey1LastRow = Survey1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Survey1LastColumn = Survey1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

For j = 2 To ToolLastRow 'For each student ID from A2 down on toolsheet
    StudentID = Tool.Cells(j, 1).Value2 '(This is how the loop knows what to look for) 'why define it if you don't use it

    'ActiveWorksheet("Survey1").Select '(This loop start with the Survey1 sheet) 'Activeworksheet -> Activeworkbook but unnecessary,see below
    For i = 1 To Survey1LastRow '(Got an overflow error here)  'you won't get an overflow error anymore
        If Cells(i, 1).Value2 = StudentID Then
            '!Unsure what to do here--need the rest of the row with the matching StudentID copied and pasted to a specific row in ToolSheet, let's say starting at G7!
            'let's put the data starting at survey1's B# to the cells starting at tool's G#
            For k = 2 To Survey1LastColumn '2 refers to B, note the difference between B=2 and G=7 is 5
                Tool.Cells(j, k + 5) = Survey1.Cells(i, k)
            Next k
        End If
    Next i
Next j

End Sub

这将检查工作簿中以“调查”开头的所有工作表中的行1：500（可以轻松更改为整列或不同范围），并将其粘贴到工具工作表中。请确保工具工作表上的学生ID之间有足够的空间，以便粘贴所有可能出现的情况。
FIND方法从这里开始：https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

Sub CreateSPSSFeed()

    Dim sStudentID As String
    Dim shtTool As Worksheet
    Dim rFoundCell As Range
    Dim sFirstFound As String
    Dim rPlacementCell As Range
    Dim lCountInToolSheet As Long
    Dim wrkSht As Worksheet

    'Set references.
    With ActiveWorkbook
        Set shtTool = .Worksheets("ToolSheet")
        sStudentID = .Worksheets("ToolSheet").Cells(2, 1).Value
    End With

    'Find where the required student id is in the tool sheet.
    With shtTool.Range("A:A")
        'Will start looking after second row (as this contains the number you're looking for).
        Set rPlacementCell = .Find(sStudentID, After:=.Cells(3), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)

        'If the Student ID doesn't appear in column A it
        'will find it in cell A2 which we don't want.
        If rPlacementCell.Address = .Cells(2).Address Then

            'Find the last row on the sheet containing data -
            'two rows below this will be the first occurence of our new Student ID.
            lCountInToolSheet = .Find("*", After:=.Cells(1), SearchDirection:=xlPrevious).Row + 2

        'An existing instance of the number was found, so count how many times it appears (-1 for the instance in A2)
        Else
            lCountInToolSheet = WorksheetFunction.CountIf(shtTool.Range("A:A"), sStudentID) - 1
        End If

        'This is where our data will be placed.
        Set rPlacementCell = rPlacementCell.Offset(lCountInToolSheet)
    End With

    'Look at each sheet in the workbook.
    For Each wrkSht In ActiveWorkbook.Worksheets

        'Only process if the sheet name starts with 'Survey'
        If Left(wrkSht.Name, 6) = "Survey" Then

            'Find each occurrence of student ID in the survey sheet and paste to the next available row
            'in the Tool sheet.
            With wrkSht.Range("A1:A500")
                Set rFoundCell = .Find(sStudentID, LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFoundCell Is Nothing Then
                    sFirstFound = rFoundCell.Address
                    Do
                        'Copy the whole row - this could be updated to look for the last column containing data.
                        rFoundCell.EntireRow.Copy Destination:=rPlacementCell
                        Set rPlacementCell = rPlacementCell.Offset(1)
                        Set rFoundCell = .FindNext(rFoundCell)
                    Loop While Not rFoundCell Is Nothing And rFoundCell.Address <> sFirstFound
                End If
            End With
            Set rFoundCell = Nothing
        End If
    Next wrkSht

End Sub

编辑：我已经添加了更多的注解和额外的代码，因为我意识到第一部分总是会找到放在单元格A2中的学生证。

试试这个：

Sub CreateSPSSFeed()

Dim StudentID As String '(StudentID is a unique identifier)
Dim rng as Range  
StudentID = Worksheet("ToolSheet").Range("A2").Value 'if you get error try to add Set = StudentID.....
j = 7
for x = 2 to sheets.count
 For i = 1 to Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row 'last not empty row

  If sheets(x).Cells (i, 1).Value = StudentID Then
   sheets(x).range(cells(i, 2),cells(i, 6)).copy _'adapt range to your needs
   Destination:=activesheet.Cells(j, 7) 'this is G7

   j = j + 1
  End If
 Next i
next x
End Sub

仅从您将数据池化到“工具”的工作表运行此代码。现在，您已经在工作表循环中嵌套了行循环。PS：不需要复制整行，只复制值范围，以避免错误。