简体   繁体   English

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

[英]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. 我对VBA还是很陌生,在编写宏时遇到了一些麻烦。

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. 我几乎把那个排序了,但只做了1行。 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. 我无法工作的是,在单元格T4中的“ sheetTarget”中读取了第一个值,在A230中的“ sheetToSearch”中找到并粘贴到“ sheetPaste”中的第1行之后,移动并读取了下一个单元格T5在“ sheetTarget”中,然后继续重复该过程,例如 find value of T5 on A350 and paste in row 2, T6 in A20 and paste on row 3, etc.. 在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

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. 一些变量不再使用,如果您有任何疑问,请随时提问。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

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