將特定列複製到excel中的新工作表中

Question

對於excel來說相當新穎，並且想知道是否有更簡單的方法來執行常規剪切複製粘貼操作。我有一個如下所示的工作表：

Fruits Nuts  Veggies 
Apple  Walnut Potato 
Banana Chestnut Broccoli 

第一行引用是標題。有沒有辦法在工作表1中搜索一個行名，一旦找到它，它會將整個列（包含行名）複製到一個新的工作表中？例如，我可以搜索「水果」，並複製整個水果專欄。結果應該是這樣的，在新的工作表：

Fruits  
Apple  
Banana 

的，如果我再次做了一個搜索堅果，結果應該是以下幾點：

Fruits Nuts  
Apple  Walnut  
Banana Chestnut 

Answer 1

這應該工作。只需將Sheet1和Sheet2更改爲您擁有的sheetname即可

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