Question

我的VBA代码是根据特定的输入条件将工作簿中多个工作表中的行复制/粘贴到另一个工作表中。它使用InStr搜索来查找在第17-50行之间的列D中以“E”开头的表格上的输入条件 - 这是有效的。

但是，当通过按钮激活sub时，它只复制/粘贴它找到的第一个条目并跳转到下一个工作表。在debug.mode中，它查找一个工作表中的所有条目，进行复制/粘贴，然后才跳转到下一个工作表。

我需要改变什么？

Sub request_task_list()

Dim rPlacementCell As Range
Dim myValue As Variant
Dim i As Integer, icount As Integer

myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen")
    If myValue = "" Then
        Exit Sub
    Else
        Set rPlacementCell = Worksheets("Collect_tool").Range("A3")
        For Each Worksheet In ActiveWorkbook.Worksheets

        'Only process if the sheet name starts with 'E'
        If Left(Worksheet.Name, 1) = "E" Then
            Worksheet.Select
                For i = 17 To 50

                    If InStr(1, LCase(Range("D" & i)), LCase(myValue)) <> 0 Then
                        'In string search for input value from msg. box
                        'Copy the whole row if found to placement cell
                        icount = icount + 1
                        Rows(i).EntireRow.Copy
                        rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats
                        Range("D2").Copy
                        rPlacementCell.PasteSpecial xlPasteValues
                        Set rPlacementCell = rPlacementCell.Offset(1)
                    End If
                Next i           
        End If
    Next Worksheet
Worksheets("collect_tool").Activate
Range("B3").Activate

End If

End Sub

Answer 1

此代码适用于我：

Sub request_task_list()

    Dim rPlacementCell As Range
    Dim myValue As Variant
    Dim i As Integer
    Dim wrkBk As Workbook
    Dim wrkSht As Worksheet

    Set wrkBk = ActiveWorkbook
    'or
    'Set wrkBk = ThisWorkbook
    'or
    'Set wrkBk = Workbooks.Open("C:/abc/def/hij.xlsx")


    myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen")
    If myValue <> "" Then
        Set rPlacementCell = wrkBk.Worksheets("Collect_tool").Range("A3") 'Be specific about which workbook the sheet is in.
        For Each wrkSht In wrkBk.Worksheets
            'Only process if the sheet name starts with 'E'
            If Left(wrkSht.Name, 1) = "E" Then
                For i = 17 To 50
                    'Cells(i,4) is the same as Range("D" & i) - easier to work with numbers than letters in code.
                    If InStr(1, LCase(wrkSht.Cells(i, 4)), LCase(myValue)) > 0 Then 'Be specific about which sheet the range is on.
                        'In string search for input value from msg. box
                        'Copy the whole row if found to placement cell
                        wrkSht.Rows(i).EntireRow.Copy
                        rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats
                        rPlacementCell.Value = wrkSht.Cells(2, 4).Value
                        Set rPlacementCell = rPlacementCell.Offset(1)
                    End If
                Next i
            End If
        Next wrkSht
        Worksheets("collect_tool").Activate
        Range("B3").Activate
    End If

End Sub

此时我猜测您的代码失败了：For Each Worksheet In ActiveWorkbook.Worksheets。 Worksheet是Worksheets集合的成员，我认为不能以这种方式使用它。请注意，在我的代码中，我将wrkSht设置为Worksheet对象，然后使用wrkSht引用循环中的当前工作表。

VBA代码仅在debug.mode中正常工作

1 个答案: