특정 열을 새 워크 시트에 Excel에서 복사하십시오.

Question

excel에 상당히 새롭고 루틴 복사 복사 붙여 넣기를 더 쉽게 수행 할 수 있는지 궁금합니다. 다음과 같은 워크 시트가 있습니다.

Fruits Nuts  Veggies 
Apple  Walnut Potato 
Banana Chestnut Broccoli 

첫 번째 행 참조는 헤더입니다. 워크 시트 1에서 행 이름을 검색하는 방법이 있습니까? 찾았 으면 열 이름 (행 이름 포함) 전체를 새 워크 시트에 복사합니까? 예를 들어, "Fruits"를 검색하고 Fruits의 전체 열을 복사합니다. 결과는 새 워크 시트에 다음과 같아야합니다

Fruits Nuts  
Apple  Walnut  
Banana Chestnut 

Answer 1

이 작동합니다 :

Fruits  
Apple  
Banana 

을 내가 너트 다시 검색을 한 경우, 그 결과는 다음이어야한다. Sheet1과 Sheet2를 가지고있는 시트 이름으로 변경하십시오.

Option Explicit 

Private Sub FindTextAndCopyToNewWS() 
Dim ws As Worksheet, targetWks As Worksheet 
Dim FindString As Variant 
Dim rng As Range, sourceColumn As Range, targetColumn As Range 
Dim lastCol As Long, lColumn As Long 

Set ws = ThisWorkbook.Worksheets("Sheet1") 

FindString = InputBox("Search for value") 

If Trim(FindString) <> "" Then 
Set rng = ws.Cells.Find(_ 
       What:=FindString, _ 
       LookIn:=xlValues, _ 
       LookAt:=xlPart, _ 
       SearchOrder:=xlByRows, _ 
       SearchDirection:=xlNext, _ 
       MatchCase:=False, _ 
       SearchFormat:=False) 

If Not rng Is Nothing Then 

    Set sourceColumn = ThisWorkbook.Worksheets("Sheet1").Columns(rng.Column) 

    Set targetWks = ThisWorkbook.Worksheets("Sheet2") 
    lastCol = targetWks.Cells(1, targetWks.Columns.Count).End(xlToLeft).Column 

    If targetWks.Cells(1, 1) = "" Then 
     Set targetColumn = ThisWorkbook.Worksheets("Sheet2").Columns(lastCol) 
    Else 
     Set targetColumn = ThisWorkbook.Worksheets("Sheet2").Columns(lastCol + 1) 
    End If 

    sourceColumn.Copy Destination:=targetColumn 

Else 
    MsgBox "Nothing found" 
End If 
End If 
End Sub