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

时间:2013-12-17 16:34:20

标签: vba

我对VBA很新,我在编写宏时遇到了一些麻烦。

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

我几乎有一个排序,但只做了一行。我无法工作的是,在“sheetTarget”中读取第一个值后,在单元格T4中,在“sheetToSearch”中找到,在A230中说并粘贴在第1行“sheetPaste”中移动并读取下一个单元格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

我将非常感谢任何帮助。

1 个答案:

答案 0 :(得分:0)

这对我有用,我相信这就是你所要求的。

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

有些变量不再使用,如果您有任何问题,请随时提出。