검색, 찾기, 복사 및 붙여 넣기 매크로 디버그 VBA

Question

나는 VBA에 새로운 것이므로 매크로를 작성하는 데 약간의 문제가 있습니다.

다른 워크 시트에있는 열의 셀에서 값을 검색하고 찾은 경우 전체 행을 복사하여 다른 워크 시트에 붙여 넣습니다.

나는 그 중 하나가 정렬되어 있지만 단지 1 행만하고있다. 내가 일할 수없는 것은 첫 번째 값이 "sheetTarget"에서 읽힌 후 T4 셀에있는 "sheetToSearch"에서 발견되고 A230에서 말하고 "sheetPaste"에있는 행 1에 붙여 넣어 다음 셀 T5를 읽은 것입니다 "sheetTarget"에 입력 한 다음 프로세스를 계속 반복하십시오.

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 

내가 크게 도움을 주셔서 감사합니다 .. A350에 T5의 값을 찾아 A20에서 2 행, T6에 붙여 3 행, 등에 붙여 넣습니다.

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 

일부 변수는 더 이상 사용되지 않으며 질문이 있으시면 언제든지 물어보십시오.