简体   繁体   中英

Copy row data based on a search to a separate sheet

I have an export of a huge database in Sheet1 (11K rows). The record identifier is in column CQ.

I have a small list (60-100) of record identifiers only in Sheet2, Column A.

I have found the following macro and made some minor modifications to it after 2 days of searching this site. This solution works partially. Find Value on other sheet and copy entire row

It will return the first row, but will not keep advancing down the column of data. When I step through, it only seems to continually loop the macro.

Here's the macro as it stands now...

Sub SearchForString()

    Dim LCopyToRow As Integer


    On Error GoTo Err_Execute


    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 1

    Dim sheetTarget As String: sheetTarget = "sheet2"
    Dim sheetToSearch As String: sheetToSearch = "sheet1"
    Dim targetValue As String: targetValue = Sheets(sheetTarget).Range("A1").Value  'Value in sheet2!A1 to be searched in sheet1
    Dim columnToSearch As String: columnToSearch = "CQ"
    Dim iniRowToSearch As Integer: iniRowToSearch = 1
    Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
    Dim maxRowToSearch As Long: maxRowToSearch = 12000 'There are lots of rows, so better setting a max. limit

    If (Not IsEmpty(targetValue)) Then
        For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count

            'If value in the current row (in columnToSearch in sheetToSearch) equals targetValue, copy entire row to LCopyToRow in sheetTarget
            If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then

                'Select row in Sheet1 to copy
                Sheets(sheetToSearch).Rows(LSearchRow).Copy

                'Paste row into Sheet2 in next row
                Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues

                'Move counter to next row
                LCopyToRow = LCopyToRow + 1
            End If

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

        Next LSearchRow

        'Position on cell A3
        Application.CutCopyMode = False
        Range("A3").Select

        MsgBox "All matching data has been copied."
    End If

    Exit Sub

You can always use the given below code to find the last updated Row for both sheet1 and sheet2 as well.

Given below is the code.

Sub Testing()
    'for getting the last row udpated, you have to enter the max range reference
    'in our case it is A1048576.  It starts from last and check what is our last
    'row with data in specific to column A.

    'Same can be used for colu
    a = Sheet1.Range("A1048576").End(xlUp).Row
End Sub

I would also suggest you this the above code for the given below line in your code.

For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count

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