過濾數值並將數據複製到新工作表

我正在尋找過濾並將主Excel數據表（表1）中的數據移動到新工作表（工作表2），但迄今爲止我發現的所有建議都涉及過濾只有一列數據，我想移動兩列。我也需要用通配符進行過濾。過濾數值並將數據複製到新工作表

我已經把它貼在我的牀單1，什麼我會非常想在片創建2

A欄是日期的圖像; B欄是動物類型; C欄是重量。

我需要一個通配符來過濾發現B列中所有的「馬」，然後移動日期，動物種類和重量，電子表格2.

我已經成功地做第一部分使用

=IF(COUNTIF(Sheet1!B2,"*horse*"),Sheet1!B2,"")

但我被困在刪除所有空白行的第二部分。

Animal weights

來源

2016-04-05 FoxxL

試試這個

Option Explicit 

Sub horses() 

With Worksheets("Sheet1").Range("B2:D100") '<== range containing data, headers included 
    .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes 
    .AutoFilter field:=2, Criteria1:="*Horse" 
    If WorksheetFunction.Subtotal(103, .Cells) > .Columns.Count Then 
     .SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Sheet2").Range("A1") '<== copying form cell "A1" of "Sheet2" 
    End If 
End With 

End Sub

適應註釋行按你的需要

來源

2016-04-05 11:25:28 user3598756

使用下面的函數來得到你的結果。您可以解析此功能的任何內容以在Sheet2中獲得結果。

Private Function filtercontent(content As String) As String 
    Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To Lastrow 
     If InStr(Cells(i, 2), content) > 0 Then 
      Worksheets("Sheet1").Range("A" & i, "C" & i).Copy 
      With Worksheets("Sheet2") 
       .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues 
      End With 
     End If 
    Next i 
End Function

或

Private Function filtercontent(content As String) As String 
    Dim Lastrow As Long 
    Dim i As Integer 
    Lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To Lastrow 
     If InStr(Cells(i, 2), content) > 0 Then 
      Worksheets("Sheet1").Range("A" & i, "C" & i).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1) 
     End If 
    Next i 
End Function

例如，如果你想申請馬過濾然後

Sub testing() 
    filtercontent ("Horse") 
End Sub

來源

2016-04-05 12:04:35

過濾數值並將數據複製到新工作表

回答

相關問題