搜索，查找，複製和粘貼宏調試VBA

Question

我是VBA的新手，我在編寫宏時遇到了一些麻煩。

我想要在另一個工作表上的某個列上的單元格中搜索值，並且如果它找到它，請將整行復制並粘貼到另一個工作表的位置。

我幾乎有一個排序，但只做1行。我無法工作的是，在單元格T4中的「sheetTarget」中讀取第一個值之後，在「sheetToSearch」中找到的第一個值在A230中說出並粘貼到「sheetPaste」中的第1行中移動並讀取下一個單元格T5在「sheetTarget」中，然後繼續重複該過程，例如。找到T5的價值對A350和第2行，T6粘貼到A20和粘貼一行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 

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