搜索，查找，复制和粘贴宏调试VBA

Question

我对VBA还是很陌生，在编写宏时遇到了一些麻烦。

我想在另一个工作表上的列的单元格中搜索值，如果找到它，则将整行复制并粘贴到另一个工作表中。

我几乎把那个排序了，但只做了1行。 我无法工作的是，在单元格T4中的“ sheetTarget”中读取了第一个值，在A230中的“ sheetToSearch”中找到并粘贴到“ sheetPaste”中的第1行之后，移动并读取了下一个单元格T5在“ sheetTarget”中，然后继续重复该过程，例如 在A350上找到T5的值并粘贴在第2行中，在A20中的T6粘贴并在第3行中粘贴，依此类推。

Sub copyE()

Dim LCopyToRow As Integer

    On Error GoTo Err_Execute

    LCopyToRow = 1

    Dim sheetPaste As String: sheetPaste = "Sheet11"
    Dim sheetTarget As String: sheetTarget = "Sheet8"
    Dim sheetToSearch As String: sheetToSearch = "Sheet1"
    Dim x As String

    Dim columnValue As String: columnValue = "T"
    Dim rowValue As Integer: rowValue = 4
    Dim LTargetRow As Long
    Dim maxRowToTarget As Long: maxRowToTarget = 1000

    Dim columnToSearch As String: columnToSearch = "A"
    Dim iniRowToSearch As Integer: iniRowToSearch = 5
    Dim LSearchRow As Long
    Dim maxRowToSearch As Long: maxRowToSearch = 1000

    For LTargetRow = rowValue To Sheets(sheetTarget).Rows.Count

    Sheets(sheetTarget).Range(columValue & CStr(LTargetRow)).Value = x


        For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count
            If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = x Then

                Sheets(sheetToSearch).Rows(LSearchRow).copy

                Sheets(sheetPaste).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues

                LCopyToRow = LCopyToRow + 1

            End If

            If (LSearchRow >= maxRowToSearch) Then
                Exit For
            End If

        Next LSearchRow

    If (LTargetRow >= maxRowToTarget) Then
         Exit For
    End If
    Next LTargetRow

       Application.CutCopyMode = False
            Range("A3").Select

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."
End Sub

我将不胜感激任何帮助。

Answer 1

这对我有用，我相信这就是您要的。

Sub test()

Dim sheetPaste As Worksheet
Dim sheetTarget As Worksheet
Dim sheetToSearch As Worksheet
Dim x As String

Dim columnValue As String: columnValue = "T"
Dim rowValue As Integer: rowValue = 4
Dim LTargetRow As Long
Dim maxRowToTarget As Long: maxRowToTarget = 1000

Dim columnToSearch As String: columnToSearch = "A"
Dim iniRowToSearch As Integer: iniRowToSearch = 5
Dim LSearchRow As Long
Dim maxRowToSearch As Long: maxRowToSearch = 1000

LCopyToRow = 1

Set sheetPaste = ThisWorkbook.Worksheets("Sheet11")
Set sheetTarget = ThisWorkbook.Worksheets("Sheet8")
Set sheetToSearch = ThisWorkbook.Worksheets("Sheet1")

'MsgBox sheetTarget.Cells(Rows.Count, 20).End(xlUp).Row
'finds the last row with a value in it in column T of sheetTarget
For LTargetRow = rowValue To sheetTarget.Cells(Rows.Count, 20).End(xlUp).Row

    'targetCell = columValue & CStr(LTargetRow)
    'must set x = , not the value in the column = to x (which is not initialize to it is "")
    If sheetTarget.Range(columnValue & CStr(LTargetRow)).Text <> "" Then
        x = sheetTarget.Range(columnValue & CStr(LTargetRow)).Text

        'finds the last row with a value in it in column A of sheetToSearch
        For LSearchRow = iniRowToSearch To sheetToSearch.Cells(Rows.Count, 1).End(xlUp).Row
            If sheetToSearch.Range(columnToSearch & CStr(LSearchRow)).Value = x Then

                sheetToSearch.Rows(LSearchRow).Copy

                sheetPaste.Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues

                LCopyToRow = LCopyToRow + 1

                Exit For

            End If

            'dont need this anymore now that we know that last row with data in it.
    '        If (LSearchRow >= maxRowToSearch) Then
    '            Exit For
    '        End If

        Next LSearchRow
    End If

'If (LTargetRow >= maxRowToTarget) Then
'     Exit For
'End If
Next LTargetRow

'Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row

End Sub

一些变量不再使用，如果您有任何疑问，请随时提问。