搜索，查找，復制和粘貼宏調試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

一些變量不再使用，如果您有任何疑問，請隨時提問。