Visual Basic-Excel 일부 시트 만 다른 시트로 복사

Question

일부 열의 값을 다른 시트로 복사하고 복사 할 수있는 방법이 있습니까?

이 사진은 더 설명 할 것입니다 : 알고 여기

내 코드이지만 내가 그나마 약간의 오차가 이유 :

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Sheets("SheetB").Select 
    ' Find the last row of data 
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
    ' Loop through each row 
    For x = 1 To FinalRow 
     ' Decide if to copy based on column A in sheetB 
     ThisValue = Cells(x, 1).Value 
     If ThisValue = Target.Value Then 
      Cells(x, 1).Resize(1, 33).Copy 
      Sheets("SheetC").Select 
      NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
      Cells(NextRow, 1).Select 
      ActiveSheet.Paste 
      Sheets("SheetB").Select 
     End If 
    Next x 

End Sub 

Answer 1

코드 아래에보십시오 :

이

친절에 헤더를 추가 코드를 실행하기 전에 시트 B의 열. 또한 나는 Worksheet_SelectionChange 이벤트 프로 시저를 사용하는 것이 좋습니다.

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

    Application.EnableEvents = False 
    On Error Resume Next 

    Dim rngFind As Range 
    Dim firstCell As String 
    Dim i As Integer 

    If Target.Column = 1 & Target.Value <> "" Then 

     Set rngFind = Sheets("SheetB").Columns(1).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, Searchorder:=xlByRows) 

     If Not rngFind Is Nothing Then firstCell = rngFind.Address 

     i = 1 
     Do While Not rngFind Is Nothing 

      Sheets("sheetC").Cells(i, 1).Value = rngFind 
      Sheets("sheetC").Cells(i, 2).Value = rngFind.Offset(0, 1) 
      Sheets("sheetC").Cells(i, 3).Value = Target.Offset(0, 1) 

      i = i + 1 
      Set rngFind = Sheets("SheetB").Columns(1).FindNext(rngFind) 
      If rngFind.Address = firstCell Then Exit Do 
     Loop 
    End If 

    Application.EnableEvents = True 
End Sub