vba 遍历工作表，查找特定值，将具有匹配值的行粘贴到另一个工作表

Loop through sheet, look for specific value, paste row with matching value to another sheet

提问by mHymanet

People take a survey and their responses end up in one row in an Excel spreadsheet. People take multiple surveys, so their responses are spread throughout multiple worksheets. These people have IDs they use before every survey.

人们进行一项调查，他们的回答最终会在 Excel 电子表格中排成一行。人们进行多项调查，因此他们的回答分布在多个工作表中。这些人在每次调查之前都有他们使用的 ID。

I want to loop through rows in each worksheet and copy certain cells from the row with a particular person's survey responses. The assumption is the person pulling responses into one spreadsheet knows the ID.

我想遍历每个工作表中的行，并从具有特定人员调查回复的行中复制某些单元格。假设是将响应放入一个电子表格的人知道 ID。

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)

Tool = ActiveWorkbook.Sheets("ToolSheet")
Survey1 = ActiveWorkbook.Sheets("Survey1Sheet")

' (This is how the loop knows what to look for)
StudentID = Worksheet("ToolSheet").Range("A2").Value 

ActiveWorksheet("Survey1").Select ' (This loop start with the Survey1 sheet)
For i = 1 to Rows.Count ' (Got an overflow error here)
    If Cells (i, 1).Value = 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!
    End If
Next i

End Sub

I researched here and haven't had a lot of luck combining loops with moving across sheets.

我在这里进行了研究，并没有很多运气将循环与跨工作表移动结合起来。

回答by Jelovac

Try this:

尝试这个：

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

Run this code only from sheet where you pooling data into "Tool". Now you have nested loop for rows in loop for sheets. PS: no need to copy entire row, just range with value, to avoid errors.

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

回答by user3819867

This one's not good, but may get you going:

这个不好，但可能会让你走：

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

回答by Darren Bartrup-Cook

This will check rows 1:500 (can easily change to entire column or different range) in all sheets in the workbook that starts with 'Survey' and paste to the tool sheet. Ensure you have enough space between student id's on the toolsheet to paste all possible occurrences.

这将检查工作簿中以“调查”开头的所有工作表中的 1:500 行（可以轻松更改为整列或不同范围）并粘贴到工具表。确保工具表上的学生 ID 之间有足够的空间来粘贴所有可能的事件。

The FIND method is from here: https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

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

Edit: I've added more comments and extra code as realised the first section would always find the Student ID that is placed in cell A2.

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