Question

对于excel来说相当新，并且想知道是否有更简单的方法来执行常规剪切复制粘贴。我有一个如下所示的工作表：

Fruits    Nuts      Veggies
Apple     Walnut    Potato
Banana    Chestnut  Broccoli

第一行引用是标题。有没有办法在工作表1中搜索行名称，一旦找到，它会将整个列（包含行名称）复制到新工作表中？例如，我可以搜索“Fruits”并复制整个Fruit的列。结果在新工作表中应如下所示：

Fruits    
Apple     
Banana

如果我再次搜索坚果，结果应如下：

Fruits    Nuts      
Apple     Walnut    
Banana    Chestnut

Answer 1

这应该有效。只需将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

将特定列复制到excel中的新工作表

1 个答案: