简体   繁体   中英

Search, find, copy and paste macro debug VBA

I am pretty new to VBA and I am having a bit of trouble writing a macro.

I want to search a value in a cell, on a column, that is on another worksheet and if it finds it, copy and paste the whole row where it is to another worksheet.

I pretty much have that one sorted but only doing 1 row. What I can't get to work is that after the first value has been read in "sheetTarget" say in cell T4, found in "sheetToSearch" say in A230 and pasted in row 1 in "sheetPaste" move and read the next cell T5 in "sheetTarget" and then keep repeating the process eg. find value of T5 on A350 and paste in row 2, T6 in A20 and paste on row 3, etc..

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

I will greatly appreciate any help.

This works for me and I believe it is what you are asking for.

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

Some of the variables are not used anymore and if you have any questions feel free to ask.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM